如何将多个工作簿中的值复制/粘贴/合并到多个工作表的MasterFile中?

时间:2017-05-29 05:54:30

标签: excel vba

我有三个工作簿,它们是我的数据源“Data1,Data2和Data3”。

enter image description here

我想将这三个工作簿中的数据放入名为“MasterFile.xlsx”的工作簿中,该工作簿有多个工作表。

“Data1”将进入MasterFile Sheet1,“Data2”进入MasterFile Sheet2,“Data3”进入MasterFile Sheet3。我的MasterFile的每张表都有一个数据模板。

enter image description here

我只能将一个工作簿中的数据合并到一个工作表中。

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

1 个答案:

答案 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.xlsData2.xlsData3.xlsData4.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)