Copier Coller données d'un fichier à un autre

Bonjour,

Voilà un message longtemps après. Je viens d'utiliser ton script @Thau Theme.

J'ai fait quelques changements, je le redonne pour qui en aurait besoin.

J'ai mon fichier principal et vais chercher les données dans plusieurs fichier dans un sous-dossier .\Pays\

Donc je boucle sur le nombre de pays listés dans un onglet Bibliothèque de mon fichier principal.

Bonne journée

Gilles

Sub IMPORTATION()

Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim Fichier As String 'déclare la variable F (Fichier)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim nbrpays As Long
Dim path As String
Dim Chemin As String
Dim lignefin As Long
Dim i As Integer

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran

nbrpays = Range("nbpays").Value + 3
Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets("SUMMARY") 'définit l'onglet destination OD
OD.Range("B26:H10000").Clear

For i = 4 To nbrpays

    Chemin = ActiveWorkbook.path & CD.Sheets("Bibliothèque").Cells(i, 2).Value
    Workbooks.Open (Chemin)
    Set CS = ActiveWorkbook 'définit le!^p classeur source CS
    Set OS = CS.Worksheets("Feuil1") 'définit l'onglet source OS
    lignefin = OS.Range("A10").End(xlDown).Row
    If lignefin > 10000 Then
        lignefin = 10
    End If
    
    'définit la cellule de destination DEST (A1 si A1 est vide, sinon, la première cellule vide de la colonne A de l'onglet destination OD)
    Set DEST = IIf(OD.Range("B26").Value = "", OD.Range("B26"), OD.Cells(Application.Rows.Count, "B").End(xlUp).Offset(3, 0))
    OS.Range(Cells(10, 1), Cells(lignefin, 8)).Copy DEST ' copie et colle "ta_plage" dans DEST ("ta_plage" représente l'adresse de ton tableau source)

    ActiveWorkbook.Close

Next i

Worksheets("SUMMARY").Select
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub