Question

我有多个工作表（如24个数字！）。我想把它合并成单张。所有工作表都有与标题类似的结构。

Glitch：在每个工作表的末尾都有一行或两行包含数据摘要

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

这是我用来合并它的一段代码。但它在单个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

Answer 1

以下代码可能对合并工作表很有用。这将要求浏览要合并的文件。然后它将所有工作表合并为一个名为＆＃34; Combine＆＃34;

的工作表

Sub Combine()
    Dim openfile As String
    MsgBox "Pls select Input file", vbOKOnly
    openfile = Application.GetOpenFilename(FileFilter:="Excel Files (*.xlsx), *.xlsx", Title:="Select File To Be Opened")
    Workbooks.OpenText (openfile)

Dim J As Integer
On Error Resume Next
Sheets(1).Select
Worksheets.Add
Sheets(1).Name = "Combined"
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
For J = 2 To Sheets.Count
Sheets(J).Activate
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next

Sheets(1).Select

End Sub

Answer 2

以下代码的作用如下：
- 代码将复制指定文件夹中所有.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

Answer 3

将它们全部放入活动工作簿后，您可以再执行一次将它们放在同一张纸上。

不知道你的数据的布局很困难，但是如果我假设A1中总有一些东西，并且它们都在一个大块中，那么你可以遍历表格并复制类似的东西：

Dim i as integer
For i = 1 to ActiveWorkbook.Sheets.Count    
   Sheets(i).Range("A1").CurrentRegion.Copy
   'Paste it into the sheet here below what's already there
Next i

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

3 个答案: