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

我有多个工作表（如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 

Answer 1

以下代码是做什么的：
– 代码将从指定文件夹中的所有.xlsx文件的所有表中复制数据， .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 2

以下代码可能对组合表单很有用。 这将要求浏览文件结合。 然后它将所有表单合并成一张名为“合并”

 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

一旦你把所有的东西都放到你的活动工作簿中，你可以做一个额外的步骤把它们放在同一张纸上。

不知道你的数据的布局是困难的，但是如果我假设在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