无法合并来自多个Excel的多个工作表的数据,且所有个体工作表的标题相同

时间:2018-07-13 06:23:00

标签: vba excel-vba

我是VBA的新手,已经去了很多领域来了解我的需求,但是遇到了一些问题。

目标:


对于所有文件,我都有3个工作表,例如sheet1,sheet2和sheet3(20个excelsheets),在所有电子表格中都一样。现在,我有另一个名为Master的文件,我需要在其中合并所有工作表。不是在主纸中的单个纸中,而是在主纸中,我还有 3张纸(Sheet1,sheet2和sheet3),因为所有纸的标题都相同


我面临的问题


下面的代码仅合并称为sheet1的第一张工作表,而不合并其他工作表sheet2和sheet3


 Sub simpleXlsMerger()
    Dim bookList As Workbook
    Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
    Application.ScreenUpdating = False
    Set mergeObj = CreateObject("Scripting.FileSystemObject")
    Set dirObj = mergeObj.Getfolder("C:\Excel\Path")

    Set filesObj = dirObj.Files
    For Each everyObj In filesObj

    Set bookList = Workbooks.Open(everyObj)

    Range("A2:IV" & Range("A65536").End(xlUp).Row).Copy
    ThisWorkbook.Worksheets(1).Activate

    'Do not change the following column. It's not the same column as above
    Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
    Application.CutCopyMode = False
    bookList.Close
    Next
 End Sub

1 个答案:

答案 0 :(得分:2)

您必须添加一个循环才能使每张打开的工作簿中的那三张床单陷入困境

尝试一下(未测试)

Option Explicit

Sub simpleXlsMerger()
    Dim bookList As Workbook
    Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
    Dim iSht As Long
    Dim masterWb As Workbook

    Set masterWb = ThisWorkbook
    Application.ScreenUpdating = False
    Set mergeObj = CreateObject("Scripting.FileSystemObject")
    Set dirObj = mergeObj.Getfolder("C:\Excel\Path")
    Set filesObj = dirObj.Files
    For Each everyObj In filesObj
        With Workbooks.Open(everyObj) ' open and reference current workbook
            For iSht = 1 To 3 ' loop through sheets index from 1 to 3
                With .Sheets(iSht) ' reference referenced workbook sheet with current index
                    .Range("A2:IV" & .Cells(.Rows.Count, 1).End(xlUp).Row).Copy Destination:=masterWb.Sheets(iSht).Cells(masterWb.Sheets(iSht).Rows.Count, 1).End(xlUp)
                End With
            Next
            .Close
        End With
    Next
End Sub