bonjour,
voila je suis débutant en VBA et j'essai de mettre en place une macro qui me permet de copier une plage de cellules d'une fichier source vers un fichier destination se trouvant dans un autre dossier,
les ligne à copier doivent répondre à une condition colonne A à OUI
a chaque fois j'ai le message d'erreur 1004
A COPIER donnée A B C
NON AZRT 47222795 MAU 1234
NON ALG 49344416 MAU 1235
OUI KFC01 49416837 46L 1236
OUI ZODE01 49696389 46L 1237
OUI KALEL 49696400 46L 1238
OUI JOREL 49712616 CLS 1239
OUI COCINEL 49867208 CLX 1240
OUI BIZARD 50959868 MXB 1241
c'est la ligne suivante qui me fait defaut à chaque fois
wbksource.Sheets("SOURCE").Range(Cells(i, "B"), Cells(i, "J")).Copy Destination:=wbkdest.Sheets("DEST").Cells(DerLigneF3, "A")
_____________________________________________
voici le code
Sub copier1()
Dim i, DerLigneF3 As Integer
Dim wbksource As Workbook, wbkdest As Workbook, x As Variant, fin&, fin1&
Dim f As Object, Fso As Object, adr$, adrd$
Dim ws As Worksheet
Set Fso = CreateObject("Scripting.FileSystemObject")
adr = ThisWorkbook.Path
Set wbksource = ThisWorkbook
Application.ScreenUpdating = False
MsgBox adr
For Each ws In wbksource.Worksheets
adrd = "d:\LocalData\ax16211\Desktop\TEST COPY\DESTINATION"
''MsgBox adrd
Application.ScreenUpdating = False
For Each f In Fso.GetFolder(adrd).Files
If Not f = ThisWorkbook.FullName And Not f Like "*~$*" Then
Set wbkdest = Workbooks.Open(f)
''MsgBox wbkdest.Name
With wbkdest.Sheets("DEST")
fin1 = wbkdest.Sheets("DEST").Range("A" & Rows.Count).End(xlUp).Row
If fin1 < 3 Then GoTo 4
'.Range("A3:S" & .Range("A65536").End(xlUp).Row).Clear
4 fin = wbksource.Sheets("SOURCE").Range("B" & Rows.Count).End(xlUp).Row
If fin < 3 Then GoTo 3
''wbksource.Sheets("APPRO").Range("A3:I" & wbksource.Sheets("APPRO").Range("A" & Rows.Count).End(xlUp).Row).Copy .Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
For i = 1 To wbksource.Sheets("SOURCE").Cells(Rows.Count, "B").End(xlUp).Row
'' erire le code relatif à la copie a partire du fichier source
If wbksource.Sheets("SOURCE").Cells(i, "A") = "OUI" Then
wbksource.Sheets("SOURCE").Cells(i, "A") = "NON"
wbksource.Sheets("SOURCE").Cells(i, "F") = Now()
''MsgBox wbksource.Sheets("CLV").Cells(i, "A").Value
DerLigneF3 = wbkdest.Sheets("DEST").Cells(Rows.Count, "A").End(xlUp).Row + 1
'' MsgBox DerLigneF3
Application.ScreenUpdating = False
wbksource.Sheets("SOURCE").Range(Cells(i, "B"), Cells(i, "J")).Copy Destination:=wbkdest.Sheets("DEST").Cells(DerLigneF3, "A")
End If
Next i
3 wbkdest.Close 1
End With
End If
Next f
''MsgBox ws.Name
Next
Application.ScreenUpdating = True
MsgBox "C'est fini", , "Traitement Terminé"
End Sub
---------------------------------------------------------------------------------
je vous remercie par avance pour votre aide
voila je suis débutant en VBA et j'essai de mettre en place une macro qui me permet de copier une plage de cellules d'une fichier source vers un fichier destination se trouvant dans un autre dossier,
les ligne à copier doivent répondre à une condition colonne A à OUI
a chaque fois j'ai le message d'erreur 1004
A COPIER donnée A B C
NON AZRT 47222795 MAU 1234
NON ALG 49344416 MAU 1235
OUI KFC01 49416837 46L 1236
OUI ZODE01 49696389 46L 1237
OUI KALEL 49696400 46L 1238
OUI JOREL 49712616 CLS 1239
OUI COCINEL 49867208 CLX 1240
OUI BIZARD 50959868 MXB 1241
c'est la ligne suivante qui me fait defaut à chaque fois
wbksource.Sheets("SOURCE").Range(Cells(i, "B"), Cells(i, "J")).Copy Destination:=wbkdest.Sheets("DEST").Cells(DerLigneF3, "A")
_____________________________________________
voici le code
Sub copier1()
Dim i, DerLigneF3 As Integer
Dim wbksource As Workbook, wbkdest As Workbook, x As Variant, fin&, fin1&
Dim f As Object, Fso As Object, adr$, adrd$
Dim ws As Worksheet
Set Fso = CreateObject("Scripting.FileSystemObject")
adr = ThisWorkbook.Path
Set wbksource = ThisWorkbook
Application.ScreenUpdating = False
MsgBox adr
For Each ws In wbksource.Worksheets
adrd = "d:\LocalData\ax16211\Desktop\TEST COPY\DESTINATION"
''MsgBox adrd
Application.ScreenUpdating = False
For Each f In Fso.GetFolder(adrd).Files
If Not f = ThisWorkbook.FullName And Not f Like "*~$*" Then
Set wbkdest = Workbooks.Open(f)
''MsgBox wbkdest.Name
With wbkdest.Sheets("DEST")
fin1 = wbkdest.Sheets("DEST").Range("A" & Rows.Count).End(xlUp).Row
If fin1 < 3 Then GoTo 4
'.Range("A3:S" & .Range("A65536").End(xlUp).Row).Clear
4 fin = wbksource.Sheets("SOURCE").Range("B" & Rows.Count).End(xlUp).Row
If fin < 3 Then GoTo 3
''wbksource.Sheets("APPRO").Range("A3:I" & wbksource.Sheets("APPRO").Range("A" & Rows.Count).End(xlUp).Row).Copy .Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
For i = 1 To wbksource.Sheets("SOURCE").Cells(Rows.Count, "B").End(xlUp).Row
'' erire le code relatif à la copie a partire du fichier source
If wbksource.Sheets("SOURCE").Cells(i, "A") = "OUI" Then
wbksource.Sheets("SOURCE").Cells(i, "A") = "NON"
wbksource.Sheets("SOURCE").Cells(i, "F") = Now()
''MsgBox wbksource.Sheets("CLV").Cells(i, "A").Value
DerLigneF3 = wbkdest.Sheets("DEST").Cells(Rows.Count, "A").End(xlUp).Row + 1
'' MsgBox DerLigneF3
Application.ScreenUpdating = False
wbksource.Sheets("SOURCE").Range(Cells(i, "B"), Cells(i, "J")).Copy Destination:=wbkdest.Sheets("DEST").Cells(DerLigneF3, "A")
End If
Next i
3 wbkdest.Close 1
End With
End If
Next f
''MsgBox ws.Name
Next
Application.ScreenUpdating = True
MsgBox "C'est fini", , "Traitement Terminé"
End Sub
---------------------------------------------------------------------------------
je vous remercie par avance pour votre aide
Pièces jointes
Dernière édition: