ouvrir plusieurs fichiers par boucle et y prendre des données

[fattah_5791]

salut
j'ai realisé une petite Macro vba me permettant d'ouvrir un fichier nommé (TCS-1.xlsx) et d'y copier des données puis les coller ds un autre classeur.

Code VBA: ce code permet de copier des données du fichier source TCS-1.xlsx et de les coller ds la feuille TC.Sc1 du classeur PV_TC-S2-2016.xlsm.

Sub Importer1()
' Importer1 Macro

Dim Fichier As String
Fichier1 = ThisWorkbook.Path & "\TCS-1.xlsx"
Workbooks.Open Fichier1
Range("B12:C56").Select
Selection.Copy
Windows("PV_TC-S2-2016.xlsm").Activate
Sheets("TC.Sc1").Select
Range("D13").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("TCS-1.xlsx").Activate
Range("D12:d56").Select
Application.CutCopyMode = False
Selection.Copy
Windows("PV_TC-S2-2016.xlsm").Activate
Range("j13").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("TCS-1").Activate
Range("H12:j56").Select
Application.CutCopyMode = False
Selection.Copy
Windows("PV_TC-S2-2016.xlsm").Activate
Range("k13").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Windows("TCS-1").Activate
Range("E12:E56").Select
Application.CutCopyMode = False
Selection.Copy
Windows("PV_TC-S2-2016.xlsm").Activate
Range("am13").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.DisplayAlerts = False
Workbooks("TCS-1.xlsx").Close False
Range("B13").Select
ActiveWorkbook.Save
End Sub


je veux faire une boucle pour repeter cela pour 10 fichiers excel source (TCS-1,......, TCS-10) sachant que les données de TCS-1 vont se loger dans la feuille TC.Sc1 du classeur PV_TC-S2-2016.xlsm et les données de TCS-2 vont se coller dans la feuille TC.Sc2 du meme classeur PV_TC-S2-2016.xlsm et ainsi de suite.

j'ai pensé à mettre le nom des fichiers source variable TCS-i sachant que i varie de 1 à 10 !!!​

 

[CPk]

Re : ouvrir plusieurs fichiers par boucle et y prendre des données

Bonjour, je vous mets un début de code qu'il faudra compléter et adapter (notamment les plages à copier collé).
il va y avoir des bugs que je ne pourrais résoudre sans fichier. Cordialement

Sub Macro1()
Dim ws As Workbook
chemin = ThisWorkbook.Path & "\"
For i = 1 To 10
Set ws = Workbooks.Open(chemin & "TCS-" & i & ".xlsx")
'Exemple de plage à copier
ws.Sheets(1).Range("a1:a15").Copy ThisWorkbook.Sheets("TC.Sc" & i).Cells(1, 1)
'ici rajouter les autres plages à copier s'il y en a plusieurs...
'....
'....

ws.Close False
Next i
End Sub