Bonjour,
Je souhaite copier une plage de donnée et deux cellules fixes, pour plusieurs excels identiques de formes, ceci vers un nouvel excel qui regroupe toutes les infos copiés et coller l'une après l'autre.
J'ai réussi à le faire pour un seul fichier excel mais pas pour plusieurs en même temps, en faisant une loop.
Sachant que la plage de donnée est variable entre les fichiers en fonction du nombre de lignes. Par exemple le premier peut avoir la plage C13:N50, le 2nd C13:N55 etc
Voici le code pour un seul fichier qui fonctionne correctement sans erreur :
maintenant j'essaye de faire la loop pour 4 fichiers dans le folder test:
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23 Sub Copy() Dim x As Workbook Dim y As Workbook Dim lastRow '## Open both workbooks first: Set x = Workbooks.Open("Z:\VBA\PARA\DOUARNENEZ_DEVIS_2 MAI.xlsx") Set y = Workbooks.Open("Z:\VBA\base-macro.xlsx") lastRow = x.Sheets("Para RF").Range("C" & Rows.count).End(xlUp).Row x.Sheets("Para RF").Range("C13:N" & lastRow).Copy y.Sheets("Feuil2").Range("C2").PasteSpecial (xlPasteValues) x.Sheets("Para RF").Range("D6").Copy y.Sheets("Feuil2").Range("A2:A" & lastRow).PasteSpecial (xlPasteValues) x.Sheets("Para RF").Range("F8").Copy y.Sheets("Feuil2").Range("B2:B" & lastRow).PasteSpecial (xlPasteValues) y.Close saveChanges:=True x.Close saveChanges:=False End Sub
le but de ma loop est d'automatiser le copy et copier les infos du 2nd fichier après les infos du 1er fichier et le 3eme apres le 2eme etc, tout le résultat doit être dans un même fichier excel destination : base-macro
en exécutant le code, j'ai un message d'erreur: erreur d'exécution 424: Objet requis. ceci sur cette partie du code :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44 Sub copy_ville_société() Dim mypath, myExtension, myfile, x, y, i, lastRow Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual Application.DisplayAlerts = False mypath = "Z:\VBA\Test\" 'Target File Extension (must include wildcard "*") myExtension = "*.xls*" 'Target Path with Ending Extention myfile = Dir(mypath & myExtension) Set y = Workbooks.Open("Z:\VBA\base-macro.xlsx") 'destination For i = 1 To 4 Set x = Workbooks.Open(mypath & myfile) 'sources lastRow = x.Sheets("Para RF").Range("C" & Rows.count).End(xlUp).Row 'dernière ligne dans sources qui est variable selon le fichier x.Sheets("Para RF").Range("C13:N" & lastRow).Copy y.Sheets("Feuil2").Range("C" & i + 1).PasteSpecial (xlPasteValues) x.Sheets("Para RF").Range("D6").Copy 'ville = tjs en D6 y.Sheets("Feuil2").Range("A" & i + 1 & ":A" & lastRow).PasteSpecial (xlPasteValues) 'je veux que la ville se répète pour toutes les lignes copiés de chaque fichier x.Sheets("Para RF").Range("F8").Copy 'Société = tjs en F8 y.Sheets("Feuil2").Range("B" & i + 1 & ":B" & lastRow).PasteSpecial (xlPasteValues) 'je veux que la société se répète pour toutes les lignes copiés de chaque fichier x.Close saveChanges:=False y.Close saveChanges:=True Next i End Subj'ai vérifié le fichier source j'ai obtenu un résultat pour le premier fichier copié, donc l'erreur ce fait au moment du copie du 2ème fichier.
Code : Sélectionner tout - Visualiser dans une fenêtre à part y.Sheets("Feuil2").Range("C" & i + 1).PasteSpecial (xlPasteValues)
je sais c'est pas logique le i que j'ai mis car i = 2 pour le premier mais pour le 2nd doit être placé à la ligne 50 par exemple or j'ai indiqué i =1 à 4 car j'ai 4 fichiers pour la loop.
je fais comment?
pouvez vous m'aider s'il vous plait?
merci beaucoup pour vos aides et suggestions.
Cheers!
Partager