VBA – 如何将多个工作簿中的值复制/粘贴/合并到具有多个工作表的MasterFile中？

美好的一天！ 我有这些多个工作簿是我的数据源，即“Data1，Data2和Data3”。 看下面的图片.. 我的问题是，我想从这3个工作簿中获取一些数据到另一个名为“MasterFile.xlsx”的工作簿，它们有多个工作表。 “Data1”将进入MasterFile Sheet1，“Data2”进入MasterFile Sheet2，“Data3”进入MasterFile Sheet3。 我的每一张MasterFile都有一个数据模板。请参阅下面的图像查看我的主文件

这是我迄今为止所做的。 我只能将数据整合到一个工作簿中。

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：________________________________________________________________________

以下是顺利执行代码的假设：

1.所有的数据文件都保存有名称Data1.xls ， Data2.xls ， Data3.xls ， Data4.xls等等。

2.数据表的Column C有值。 这是用于计算工作表中logging数的列。

3.主文件页的Column B列是用于统计表中logging数的列。

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 eg 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 

编辑2：________________________________________________________________________

您可以为文件名创build另一个数组，如下所示：

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

然后replace下面的行

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

至

 Filename = fileArray(j)