将不同文件中的多个工作表中的数据导入单个工作簿

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

试试这个方法。

更改此代码行中的范围

'填写要复制的范围 设置 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