Macro excel

[Cazinos]

Bonjour le forum,

Voici une macro capable de recopier des lignes sur des onglets spécifiques

Il y a 5 onglets :
1- BDD TEXTE PAYE
2- CP
3- CF
4 - CP
5 - SG

Sur excel 97 aucun soucis (environ 1 minute pour 15 000 lignes) mais depuis que nous avons excel 2002 la macro rame et ne finis pas son travail (après 15 minutes elle n'a toujours pas terminé sont travail)

merci de m'aider à comprendre pourquoi


Sub RecopierEntités()

Dim Cel As Range
For Each Cel In Sheets("BDD TEXTE PAYE").Range("d:d")
Select Case Cel
Case "BX"
'il faut que les cellules A1 et A2 de chaque feuille contiennent qq chose
'sinon prévoir leur remplissage
If Sheets("BX").Range("A1") <> "" And Sheets("BX").Range("A2") <> "" Then
Cel.EntireRow.Copy (Sheets("BX").Range("A1").End(xlDown).Offset(1, 0))
ElseIf Sheets("BX").Range("A1") = "" Then
Cel.EntireRow.Copy (Sheets("BX").Range("A1"))
ElseIf Sheets("BX").Range("A1") <> "" And Sheets("BX").Range("A2") = "" Then
Cel.EntireRow.Copy (Sheets("BX").Range("A2"))
End If
Case "CP"
'faire idem pour chaque feuille
Cel.EntireRow.Copy (Sheets("CP").Range("A1").End(xlDown).Offset(1, 0))
Case "CF"
Cel.EntireRow.Copy (Sheets("CF").Range("A1").End(xlDown).Offset(1, 0))
Case "SG"
Cel.EntireRow.Copy (Sheets("SG").Range("A1").End(xlDown).Offset(1, 0))
End Select
Next

End Sub

 

[bof]

Re : Macro excel

Bonjour,
Tu as de la chance car chez moi ça plante direct :
Remplace chaque ligne ou tu as un Offset par quelque chose comme ça :
Cel.EntireRow.Copy Sheets("BX").Range("A" & Sheets("BX").Range("A1").End(xlDown).Offset(1, 0).Row)
A+

 

[Cazinos]

Re : Macro excel

Bonsoir le forum,

Merci pour ta réponse :

j'ai changé la comme tu me l'a expliqué ci-dessus :
Cel.EntireRow.Copy Sheets("BX").Range("A" & Sheets("BX").Range("A1").End(xlDown).Offset(1, 0).Row)

ca change rien c'est aussi lent

merci