Problème macro extraction colonnes
R
Bonjour,
J'ai un fichier excel pour lequel je ne veux extraire que les lignes B,C,D,J,K et L.
Voici la macro que j'ai déjà crée :
Sub extract()
Application.ScreenUpdating = False
' ws1= reference à la feuille des clients
Set ws1 = Worksheets("Feuil1")
' i pointeur de ligne dans la feuille clients
i = 2
' nplc client en cours de traitement
nplc = ""
' on parcourt la feuille des clients
While ws1.Cells(i, "B") <> 0
' si le numéro de client sur la ligne i est différent du client en cours
If ws1.Cells(i, "B") <> nplc Then
' si client en cours est non blanc
If nplc <> "" Then
' on ajoute des formule et M2 et N2 sur l'extrait client
ws2.Range("M2").FormulaR1C1 = "=SUM(C[-2])"
ws2.Range("N2").FormulaR1C1 = "=SUM(C[-2])"
' on sauve le classeur de ce client
wb.SaveAs ws2.Name & ".xlsx"
wb.Close
End If
' on crée un nouveau classeur extrait client
' wb classeur extrait client
Set wb = Workbooks.Add
' ws2 feuille extrait client
Set ws2 = wb.Worksheets(1)
' nplc = client en cours
nplc = ws1.Cells(i, "B")
Application.StatusBar = "client " & nplc & " en cours de création"
ws2.Name = "client " & nplc
' on y copie la ligne titre
ws1.Range("A1:L1").Copy ws2.Range("A1")
' j pointeur de ligne dans le classeur extrait client
j = 1
End If
' si on n'a pas (A<2 ET B<4) sur cette ligne
If Not (ws1.Range("K" & i) < 2 And ws1.Range("L" & i) < 4) Then
' incrémente pointeur de ligne
j = j + 1
'on copie la ligne
ws1.Rows(i).Copy ws2.Range("B:D,J:L")
End If
' on passe à la ligne client suivante
i = i + 1
Wend
' on ferme le dernier classeur
wb.SaveAs ws2.Name & ".xlsx"
wb.Close
Application.ScreenUpdating = True
Set ws1 = Nothing
Set ws2 = Nothing
Application.StatusBar = "traitement terminé"
End SubJe n'arrive pas à comprendre ce qu'il y a de faux...
On me donne l'erreur à la ligne :
ws1.Rows(i).Copy ws2.Range("B:D,J:L")Bonjour
Sans fichier
Essayes de modifier la partie de code suivante
If Not (ws1.Range("K" & i) < 2 And ws1.Range("L" & i) < 4) Then
' incrémente pointeur de ligne
j = j + 1
'on copie la ligne
[surligner=#FFFF80]'ws1.Rows(i).Copy ws2.Range("B:D,J:L")
ws1.Range("B" & i & ":D" & i).Copy ws2.Range("B" & j)
ws1.Range("J" & i & ":L" & i).Copy ws2.Range("J" & j)
End IfSi pas ça
R
Merci beaucoup à toi je te remercie infiniment!