将不同的工作表合并为一张工作表（仅指定的行）

SriLaks 发表于 Dev

斯里兰卡

我有多个工作表（例如24个！）。我想将其合并为一张纸。所有工作表的标题都具有相似的结构。

小故障：每个工作表的末尾都有一两行包含数据摘要

我想省略这些行，并保留所有工作表的继续数据。

这是我用来合并的一段代码。但是它在单个excel文件中制作了多个工作表。是否可以在这段代码中添加一些代码。

提前致谢！

Sub GetSheets()
Path = "C:\path"
Filename = Dir(Path & "*.XLSX")
  Do While Filename <> ""
  Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
       For Each Sheet In ActiveWorkbook.Sheets
     Sheet.Copy After:=ThisWorkbook.Sheets(1)
      
  Next Sheet
     Workbooks(Filename).Close
     Filename = Dir()
  Loop
End Sub

格里格

以下代码的作用是：
-代码将复制.xlsx指定文件夹中所有文件的所有工作表中的数据，假设所有文件具有相同的结构
-数据被复制到Output活动文件的工作表名称中
-假设其包含以下内容，则不复制每张工作表的最后一行数据摘要
-页眉将从第一张工作表中复制
-代码不会将工作表添加到当前文件

Sub GetSheets()
    Dim path As String, fileName As String
    Dim lastRow As Long, rowCntr As Long, lastColumn As Long
    Dim outputWS As Worksheet

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    'this is the sheet where all the data will be displyed        
    Set outputWS = ThisWorkbook.Sheets("Output")
    rowCntr = 1

    path = "C:\path" & "\"
    fileName = Dir(path & "*.XLSX")
    Do While fileName <> ""
        Workbooks.Open fileName:=path & fileName, ReadOnly:=True
        For Each ws In ActiveWorkbook.Sheets
            If rowCntr = 1 Then
                'get column count
                lastColumn = ws.Cells(1, Columns.Count).End(xlToLeft).Column
                'copy header
                Range(outputWS.Cells(1, 1), outputWS.Cells(1, lastColumn)).Value = Range(ws.Cells(1, 1), ws.Cells(1, lastColumn)).Value
                rowCntr = rowCntr + 1
            End If
            'get last row with data of each sheet
            lastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
            'copy data from each sheet to Output sheet
            Range(outputWS.Cells(rowCntr, 1), outputWS.Cells(rowCntr + lastRow - 3, lastColumn)).Value = Range(ws.Cells(2, 1), ws.Cells(lastRow - 1, lastColumn)).Value
            rowCntr = rowCntr + lastRow - 2
        Next ws
        Workbooks(fileName).Close
        fileName = Dir()
    Loop

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub