我有三个工作簿,它们是我的数据源“Data1,Data2和Data3”。
我想将这三个工作簿中的数据放入名为“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
答案 0 :(得分: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
数据表包含值。这是用于计算工作表中记录数的列。
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
编辑2:________________________________________________________________________
您可以为文件名创建另一个数组,如下所示:
Dim fileArray() As Variant
fileArray = Array("Schools.xlsx", "Students.xlsx", "Managers.xlsx")
然后替换下面的行
Filename = "Data" & j + 1 & ".xlsx"
到
Filename = fileArray(j)