XL 2019 EXECEL

Sub Copier()
Dim chemin$, fichier$, plage As Range
chemin = ThisWorkbook.Path & "\"
fichier = Dir(chemin & "*.xls*")
Set plage = ThisWorkbook.Worksheets(1).Cells '1ère feuille de calcul
Application.ScreenUpdating = False
While fichier <> ""
    If fichier <> ThisWorkbook.Name Then
        With Workbooks.Open(chemin & fichier)
            plage.Copy .Worksheets(1).Cells(1) 'copier-coller
            .Close True 'enregistre et ferme le fichier
        End With
    End If
    fichier = Dir
Wend
With plage(1).MergeArea: .Copy plage(1): .Merge: End With 'allège la mémoire
End Sub

Sub Copier()
Dim fichier As Variant, plage As Range
fichier = Application.GetOpenFilename("Fichiers Excel(*.xls*),*.xls*")
If fichier = False Then Exit Sub
Set plage = ThisWorkbook.Worksheets(1).Cells '1ère feuille de calcul
Application.ScreenUpdating = False
With Workbooks.Open(fichier)
    plage.Copy .Worksheets(1).Cells(1) 'copier-coller
    .Close True 'enregistre et ferme le fichier
End With
With plage(1).MergeArea: .Copy plage(1): .Merge: End With 'allège la mémoire
End Sub

Sub Copier()
Dim plage As Range, i%
Set plage = ThisWorkbook.Worksheets(1).Cells '1ère feuille de calcul
With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = True
    .Filters.Add "Classeurs Excel", "*.xls*"
    MsgBox "Sélectionnez les classeurs de destination"
    If Not .Show Then Exit Sub
    Application.ScreenUpdating = False
    For i = 1 To .SelectedItems.Count
        If .SelectedItems(i) <> ThisWorkbook.FullName Then
        With Workbooks.Open(.SelectedItems(i))
            plage.Copy .Worksheets(1).Cells(1) 'copier-coller
            .Close True 'enregistre et ferme le fichier
        End With
        End If
    Next
End With
With plage(1).MergeArea: .Copy plage(1): .Merge: End With 'allège la mémoire
End Sub

Sub Copier()
Dim plage As Range, i%
Set plage = ThisWorkbook.Worksheets(1).Cells '1ère feuille de calcul
With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = True
    .Filters.Add "Classeurs Excel", "*.xls*"
    MsgBox "Sélectionnez les classeurs de destination"
    If Not .Show Then Exit Sub
    Application.ScreenUpdating = False
    For i = 1 To .SelectedItems.Count
        If .SelectedItems(i) <> ThisWorkbook.FullName Then
        With Workbooks.Open(.SelectedItems(i))
            .Worksheets.Add Before:=.Worksheets(1) 'ajoute une nouvelle feuille
            plage.Copy .Worksheets(1).Cells(1) 'copier-coller
            .Close True 'enregistre et ferme le fichier
        End With
        End If
    Next
End With
With plage(1).MergeArea: .Copy plage(1): .Merge: End With 'allège la mémoire
End Sub