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

Question

我有多项工作sheet（大概有 24 个！）。我想把它合并成一个sheet。所有作品 sheet 的结构与 header.

相似

故障：在每个工作结束时sheet有一两行数据摘要

我想省略那些行并继续所有工作的数据sheet。

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

提前致谢！

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

将它们全部放入活动工作簿后，您可以执行额外的步骤将它们放在同一个 sheet。

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

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

Answer 2

以下代码可能对组合 sheet 有用。这将要求浏览文件进行合并。然后它将所有 sheet 组合成一个名为 "Combine"

的 sheet

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 3

以下代码的作用：
- 代码将从指定文件夹中所有 .xlsx 文件的所有 sheet 复制数据，假设所有文件都具有相同的结构
- 数据被复制到活动文件
的 sheet 名称 Output - 每个 sheet 的最后一行假设它包含数据摘要
则不会被复制 - Header将从第一个复制的sheet
开始复制 - 代码不会将 sheets 添加到当前文件

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

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

Merging different worksheet into one sheet (only specified rows)

excel

vba

excel-2013