Question

我正在尝试将不同数量的工作表合并为一个。此代码打开我的目录中的任意数量的文件，并复制/粘贴每个名为＆＃34; data＆＃34;进入＆＃34; makrotochange.xlsm＆＃34;这是我的大师级作品。

 Sub LoopThroughFiles()
   Dim StrFile As String
   Dim WB As Workbook
   Dim InputFilePath As String
InputFilePath = "Z:\1000_Entwicklung\05_PROJECT\0558000_CFT\055800L_CFT_Projektleitung\99_Arbeitsordner PL\Tanverdi, Yigit\SAA\"
StrFile = Dir(InputFilePath & "*")

Do While Len(StrFile) > 0
    Set WB = Workbooks.Open(InputFilePath & StrFile)
    WB.Activate
        Sheets("data").Select
        Sheets("data").Move After:=Workbooks("makrotochange.xlsm").Sheets(23)
        StrFile = Dir()
Loop
End Sub

每个数据工作表都有从A到ZZ的列，行数不同，我希望将这些复制/粘贴的数据表合并到我的masterworkbook中的一个工作表中，并且＃34; makrotochange.xlsm＆＃34;。

如何将这些工作表合并为一个？

Answer 1

这样的事情：

Sub LoopThroughFiles()

    Dim StrFile As String
    Dim WB As Workbook, rng As Range
    Dim InputFilePath As String

    InputFilePath = "Z:\1000_Entwicklung\05_PROJECT\0558000_CFT\" & _
            "055800L_CFT_Projektleitung\99_Arbeitsordner PL\Tanverdi, Yigit\SAA\"

    StrFile = Dir(InputFilePath & "*")

    Do While Len(StrFile) > 0

        Set WB = Workbooks.Open(InputFilePath & StrFile)

        'follwoing assumes your data is tabular with no empty rows/columns
        Set rng = WB.Sheets("data").Range("A1").CurrentRegion

        'exclude the header row
        Set rng = rng.Resize(rng.Rows.Count - 1, rng.Columns.Count).Offset(1, 0)

        'copy to the macro workbook at next empty row
        'NOTE: ColA must always contain a value
        '      Also assuming there's enough room for the paste...
        rng.Copy ThisWorkbook.Sheets("Data").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

    Loop
End Sub

将复制粘贴的工作表整理成一个

1 个答案: