Импорт данных из нескольких листов в разных файлах в одну книгу

Question

Я пытаюсь импортировать данные из нескольких рабочих книг (файлы Excel, выбранные в диалоговом окне выбора файлов) в одну рабочую книгу.Каждая рабочая тетрадь содержит 3 листа, причем как рабочая тетрадь, так и источник листов, а назначения книг и листов имеют одинаковую структуру.Код уже работает, если я выбираю один файл, но не копирует результаты на листе назначения, если я выбираю 2 или более файлов.Я пробовал разные решения, но код VBA является новым для меня, и я не могу понять, что не так.Может кто-нибудь сказать, что не так с кодом, пожалуйста?

Const premiere_ligne_J = 6

Sub import_donnees_J(chemin_tem)

Application.Calculation = xlCalculationManual

Dim dataJ As Worksheet
Set dataJ = ThisWorkbook.Worksheets("Import data Sheet 1")
Dim Ctr

Application.DisplayAlerts = False


For Ctr = 1 To Application.FileDialog(msoFileDialogFilePicker).SelectedItems.Count

Workbooks.Open (chemin_tem)
tem = ActiveWorkbook.Name

Workbooks(tem).Activate
Application.DisplayAlerts = True

Set templateJ = Workbooks(tem).Sheets("Import data Sheet 1")
dernier_client = templateJ.Range("A" & Rows.Count).End(xlUp).Row

ligne = premiere_ligne_J

For client = premiere_ligne_J To dernier_client

    'Copying data
    For col = colJ_pdl_data To colJ_rapport_precision_data
        dataJ.Cells(ligne, col) = templateJ.Cells(client, col)
    Next col

ligne = ligne + 1 
suite::
Next client

Workbooks(tem).Close SaveChanges:=False
Next Ctr
Application.Calculation = xlCalculationAutomatic
End Sub`

This fuction is almost the same for the 3 sheets to import.

The main program calls these functions 
Call Import1.import_donnees_J(chemin_tem)
Call Import2.import_donnees_V(chemin_tem)
Call Import3.import_donnees_B(chemin_tem)

Chemin_tem is defined as below : 
chemin_tem = CStr(Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1))

Answer 1

Попробуйте так.

Измените диапазон в этой строке кода

'Заполните диапазон, который вы хотите скопировать. Set CopyRng = sh.Range ("A1: G1")

Sub CopyRangeFromMultiWorksheets()
    Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim Last As Long
    Dim CopyRng As Range

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Delete the sheet "RDBMergeSheet" if it exist
    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    'Add a worksheet with the name "RDBMergeSheet"
    Set DestSh = ActiveWorkbook.Worksheets.Add
    DestSh.Name = "RDBMergeSheet"

    'loop through all worksheets and copy the data to the DestSh
    For Each sh In ActiveWorkbook.Worksheets
        If sh.Name <> DestSh.Name Then

            'Find the last row with data on the DestSh
            Last = LastRow(DestSh)

            'Fill in the range that you want to copy
            Set CopyRng = sh.Range("A1:G1")

            'Test if there enough rows in the DestSh to copy all the data
            If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
                MsgBox "There are not enough rows in the Destsh"
                GoTo ExitTheSub
            End If

            'This example copies values/formats, if you only want to copy the
            'values or want to copy everything look at the example below this macro
            CopyRng.Copy
            With DestSh.Cells(Last + 1, "A")
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With

            'Optional: This will copy the sheet name in the H column
            DestSh.Cells(Last + 1, "H").Resize(CopyRng.Rows.Count).Value = sh.Name

        End If
    Next

ExitTheSub:

    Application.Goto DestSh.Cells(1)

    'AutoFit the column width in the DestSh sheet
    DestSh.Columns.AutoFit

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

https://www.rondebruin.nl/win/s3/win002.htm