VBA - 如何將多個工作簿中的值複製/粘貼/合併到具有多個工作表的MasterFile中？

Question

美好的一天！我有這些多個工作簿，它們是我的數據源，即「Data1，Data2和Data3」。見下圖.. 我的問題是，我想從這3個工作簿中獲取一些數據到另一個名爲「MasterFile.xlsx」的工作簿中，它有多個工作表。 「Data1」將進入MasterFile Sheet1，「Data2」進入MasterFile Sheet2，「Data3」進入MasterFile Sheet3。我的主文件的每片早已爲data..Please模板見下面的圖片爲我的主文件

這是我到目前爲止已經完成。我只能將數據合併到一張工作簿中。

Public Sub Data() 
Dim wbk As Workbook 
Dim Filename As String 
Dim Path As String 
Dim sht, msht As Worksheet 
Dim lRowFile, lRowMaster As Long 
Dim FirstDataSet As Integer 

On Error Resume Next 

Path = "C:\Users\source\" 

Filename = "Data1.xlsx" 

Set wbk = Workbooks.Open(Path & Filename) 

Set sht = Workbooks(Filename).Worksheets(1) 
Set msht = ThisWorkbook.Worksheets(1) 

lrF = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row 
lRM = msht.Cells(Rows.Count, 2).End(xlUp).Row 
FirstDataSet = 2 

For i = FirstDataSet To lrF 
    lRM = msht.Cells(Rows.Count, 2).End(xlUp).Row 
    msht.Range("B" & lRM + 1).Value = sht.Range("A" & i).Value 
    msht.Range("C" & lRM + 1).Value = sht.Range("E" & i).Value 
    msht.Range("E" & lRM + 1).Value = sht.Range("B" & i).Value 
    msht.Range("F" & lRM + 1).Value = sht.Range("D" & i).Value 
    msht.Range("I" & lRM + 1).Value = sht.Range("F" & i).Value 
    msht.Range("J" & lRM + 1).Value = sht.Range("G" & i).Value 
    msht.Range("K" & lRM + 1).Value = sht.Range("H" & i).Value 
    msht.Range("L" & lRM + 1).Value = sht.Range("I" & i).Value 
    msht.Range("M" & lRM + 1).Value = sht.Range("J" & i).Value 
    msht.Range("N" & lRM + 1).Value = sht.Range("K" & i).Value 
Next 
wbk.Close True 

End Sub 

請幫幫我 謝謝！

Answer 1

下面可能會有所幫助

Public Sub Data() 
    Application.ScreenUpdating = False 
    Dim wbk As Workbook 
    Dim Filename As String 
    Dim Path As String 
    Dim sht, msht As Worksheet 
    Dim shtLR, mshtLR As Long 
    Dim FirstDataSet As Integer 

    On Error Resume Next 

    Path = "C:\Users\source\" 
    FirstDataSet = 2 

    '------------------------------For Sheet1------------------------------ 
    Filename = "Data1.xlsx" 
    Set wbk = Workbooks.Open(Path & Filename) 
    Set sht = Workbooks(Filename).Worksheets(1) 

    Set msht = ThisWorkbook.Worksheets(1) 

    shtLR = sht.Cells(Rows.Count, "C").End(xlUp).Row 
    mshtLR = msht.Cells(Rows.Count, "B").End(xlUp).Row 

    msht.Range("B" & mshtLR + 1 & ":B" & mshtLR - 1 + shtLR).Value = sht.Range("C" & FirstDataSet & ":C" & shtLR).Value 
    msht.Range("C" & mshtLR + 1 & ":C" & mshtLR - 1 + shtLR).Value = sht.Range("E" & FirstDataSet & ":E" & shtLR).Value 
    msht.Range("E" & mshtLR + 1 & ":E" & mshtLR - 1 + shtLR).Value = sht.Range("G" & FirstDataSet & ":G" & shtLR).Value 
    msht.Range("F" & mshtLR + 1 & ":F" & mshtLR - 1 + shtLR).Value = sht.Range("D" & FirstDataSet & ":D" & shtLR).Value 
    msht.Range("I" & mshtLR + 1 & ":I" & mshtLR - 1 + shtLR).Value = sht.Range("F" & FirstDataSet & ":F" & shtLR).Value 
    msht.Range("J" & mshtLR + 1 & ":J" & mshtLR - 1 + shtLR).Value = sht.Range("H" & FirstDataSet & ":H" & shtLR).Value 
    msht.Range("K" & mshtLR + 1 & ":K" & mshtLR - 1 + shtLR).Value = sht.Range("I" & FirstDataSet & ":I" & shtLR).Value 
    msht.Range("L" & mshtLR + 1 & ":L" & mshtLR - 1 + shtLR).Value = sht.Range("J" & FirstDataSet & ":J" & shtLR).Value 
    msht.Range("M" & mshtLR + 1 & ":M" & mshtLR - 1 + shtLR).Value = sht.Range("K" & FirstDataSet & ":K" & shtLR).Value 
    msht.Range("N" & mshtLR + 1 & ":N" & mshtLR - 1 + shtLR).Value = sht.Range("L" & FirstDataSet & ":L" & shtLR).Value 

    wbk.Close True 


    '------------------------------For Sheet2------------------------------ 
    Filename = "Data2.xlsx" 
    Set wbk = Workbooks.Open(Path & Filename) 
    Set sht = Workbooks(Filename).Worksheets(1) 

    Set msht = ThisWorkbook.Worksheets(2) 

    shtLR = sht.Cells(Rows.Count, "A").End(xlUp).Row 
    mshtLR = msht.Cells(Rows.Count, "B").End(xlUp).Row 

    msht.Range("B" & mshtLR + 1 & ":B" & mshtLR - 1 + shtLR).Value = sht.Range("B" & FirstDataSet & ":B" & shtLR).Value 
    msht.Range("C" & mshtLR + 1 & ":C" & mshtLR - 1 + shtLR).Value = sht.Range("D" & FirstDataSet & ":D" & shtLR).Value 
    msht.Range("D" & mshtLR + 1 & ":D" & mshtLR - 1 + shtLR).Value = sht.Range("E" & FirstDataSet & ":E" & shtLR).Value 
    msht.Range("F" & mshtLR + 1 & ":F" & mshtLR - 1 + shtLR).Value = sht.Range("G" & FirstDataSet & ":G" & shtLR).Value 
    msht.Range("G" & mshtLR + 1 & ":G" & mshtLR - 1 + shtLR).Value = sht.Range("H" & FirstDataSet & ":H" & shtLR).Value 
    msht.Range("J" & mshtLR + 1 & ":J" & mshtLR - 1 + shtLR).Value = sht.Range("J" & FirstDataSet & ":J" & shtLR).Value 
    msht.Range("K" & mshtLR + 1 & ":K" & mshtLR - 1 + shtLR).Value = sht.Range("K" & FirstDataSet & ":K" & shtLR).Value 
    msht.Range("L" & mshtLR + 1 & ":L" & mshtLR - 1 + shtLR).Value = sht.Range("L" & FirstDataSet & ":L" & shtLR).Value 

    wbk.Close True 


    '------------------------------For Sheet3------------------------------ 
    Filename = "Data3.xlsx" 
    Set wbk = Workbooks.Open(Path & Filename) 
    Set sht = Workbooks(Filename).Worksheets(1) 

    Set msht = ThisWorkbook.Worksheets(3) 

    shtLR = sht.Cells(Rows.Count, "C").End(xlUp).Row 
    mshtLR = msht.Cells(Rows.Count, "B").End(xlUp).Row 

    msht.Range("B" & mshtLR + 1 & ":B" & mshtLR - 1 + shtLR).Value = sht.Range("D" & FirstDataSet & ":D" & shtLR).Value 
    msht.Range("C" & mshtLR + 1 & ":C" & mshtLR - 1 + shtLR).Value = sht.Range("F" & FirstDataSet & ":F" & shtLR).Value 
    msht.Range("E" & mshtLR + 1 & ":E" & mshtLR - 1 + shtLR).Value = sht.Range("G" & FirstDataSet & ":G" & shtLR).Value 
    msht.Range("F" & mshtLR + 1 & ":F" & mshtLR - 1 + shtLR).Value = sht.Range("I" & FirstDataSet & ":I" & shtLR).Value 
    msht.Range("I" & mshtLR + 1 & ":I" & mshtLR - 1 + shtLR).Value = sht.Range("J" & FirstDataSet & ":J" & shtLR).Value 
    msht.Range("J" & mshtLR + 1 & ":J" & mshtLR - 1 + shtLR).Value = sht.Range("K" & FirstDataSet & ":K" & shtLR).Value 
    msht.Range("K" & mshtLR + 1 & ":K" & mshtLR - 1 + shtLR).Value = sht.Range("L" & FirstDataSet & ":L" & shtLR).Value 

    wbk.Close True 

    Application.ScreenUpdating = True 
End Sub 

編輯1：________________________________________________________________________

以下是代碼的順利執行的假設：所有的數據文件都保存

名稱爲Data1.xls,Data2.xls,Data3.xls,Data4.xls等等。

2.Column C數據表有值。這是用於計算工作表中記錄數的列。

3.Column B主文件表是用於統計表單中記錄數的列。

4.Master file中紙張的計數與數據文件的數量相同。 ________________________________________________________________________

可以使另一個數組對文件名如下：：這將使用m1Array()

Option Explicit 

Public Sub Data() 
    Application.ScreenUpdating = False 
    Dim wbk As Workbook 
    Dim Filename As String 
    Dim Path As String 
    Dim sht, msht As Worksheet 
    Dim shtLR, mshtLR As Long 
    Dim FirstDataSet, i, j As Integer 
    Dim m1Array(), m2Array() As Variant 

    On Error Resume Next 

    'm1Array is the array where column names of the data files e.g. data1.xls, data2.xls, etc. are stored 
    m1Array = Array(Array("B", "C", "E", "F", "I", "J", "K", "L", "M", "N"), _ 
        Array("B", "C", "D", "F", "G", "J", "K", "L"), _ 
        Array("B", "C", "E", "F", "I", "J", "K")) 

    'm2Array is the array where column names of the master file sheet are stored 
    m2Array = Array(Array("C", "E", "G", "D", "F", "H", "I", "J", "K", "L"), _ 
        Array("B", "D", "E", "G", "H", "J", "K", "L"), _ 
        Array("D", "F", "G", "I", "J", "K", "L")) 

    Path = "C:\Users\source\" 
    FirstDataSet = 2 

    'looping through all the data files 
    For j = LBound(m1Array) To UBound(m1Array) 
     Filename = "Data" & j + 1 & ".xlsx" 
     Set wbk = Workbooks.Open(Path & Filename) 
     Set sht = Workbooks(Filename).Worksheets(1) 

     Set msht = ThisWorkbook.Worksheets(j + 1) 

     shtLR = sht.Cells(Rows.Count, "C").End(xlUp).Row 
     mshtLR = msht.Cells(Rows.Count, "B").End(xlUp).Row 

     'looping through each columns of the data sheet and corresponding master file sheet 
     For i = LBound(m1Array(j)) To UBound(m1Array(j)) 
      msht.Range(m1Array(j)(i) & mshtLR + 1 & ":" & m1Array(j)(i) & mshtLR - 1 + shtLR).Value = sht.Range(m2Array(j)(i) & FirstDataSet & ":" & m2Array(j)(i) & shtLR).Value 
     Next i 

     wbk.Close True 
    Next j 
    Application.ScreenUpdating = True 
End Sub 

EDIT 2的長度來確定

Dim fileArray() As Variant 
fileArray = Array("Schools.xlsx", "Students.xlsx", "Managers.xlsx") 

然後替換下面線

Filename = "Data" & j + 1 & ".xlsx" 

到

Filename = fileArray(j)