Excel 将不同记录数的不同工作表中的行合并到主工作表中

我有多个工作表，每个工作表中的行数不同，但列名相同，我如何逐行追加（意味着第一行来自第一张工作表，第二行应追加为来自第二张工作表，第三行以来自第三张工作表的方式追加并继续追加）进入一张母版图纸，其中包含从多张图纸中逐个获取的所有行。有人能帮我解决这个问题吗 提前谢谢

StackOverflow不是“为我编写代码”服务

也就是说，我已经为这个目的编写了代码。请注意，它不会检查以确保列对齐。。。只是假设他们都排对了。如果您只选择了一个选项卡，它将合并所有可见的选项卡。如果选择了多个选项卡，它将仅合并这些选项卡

它也不会检查以确保您输入的图纸名称不存在，如果您输入的是现有名称，则会抛出错误

此版本假定每个选项卡都有标题，并排除后续选项卡上的第一行：

Public Sub MergeTabs()

'Merges selected tabs (or all visible tabs if only 1 selected) in current workbook into a new tab

Dim i As Integer, wb As Workbook, w As Window, wsTo As Worksheet, wsFrom As Collection   'Worksheet collection
Dim strScope As String, strNewTab As String
Dim raTarget As Range

Set wb = ActiveWorkbook
Set w = ActiveWindow

Set wsFrom = New Collection

If w.SelectedSheets.Count = 1 Then
    For i = 1 To wb.Worksheets.Count
        If wb.Worksheets(i).Visible Then wsFrom.Add wb.Worksheets(i)
    Next
    strScope = "ALL VISIBLE"
Else
    For i = 1 To w.SelectedSheets.Count
        If w.SelectedSheets(i).Visible Then wsFrom.Add w.SelectedSheets(i)
    Next
    strScope = wsFrom.Count & " SELECTED"
End If

strNewTab = InputBox("Merge data from " & strScope & " sheets to new sheet named:", "Merge tabs", "All")
If strNewTab = vbNullString Then Exit Sub

Set wsTo = wb.Worksheets.Add(wsFrom(1), Count:=1) 'Add before first selected sheet
wsTo.Name = strNewTab

wsFrom(1).Range("A1").CurrentRegion.Copy
wsTo.Range("A1").PasteSpecial xlPasteFormulasAndNumberFormats
Application.CutCopyMode = False

For i = 2 To wsFrom.Count
    wsFrom(i).Range("A2", wsFrom(i).Range("A1").CurrentRegion.Cells(wsFrom(i).Range("A1").CurrentRegion.Cells.Count)).Copy
    wsTo.Cells(wsTo.Cells.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
    Application.CutCopyMode = False
Next i

wsTo.Range("A1").Select

MsgBox "Merge Done"

End Sub

此版本假定没有标题（或第一个选项卡上只有标题）：

---

H非常感谢，但即使在选择了多张工作表之后，查询也不起作用，它只从一张工作表中获取数据。它还假设所有数据都从每张工作表的单元格A1开始。同一工作簿中的所有工作表以及数据以A1开头的所有工作表？是的，我在同一工作簿中有所有工作表，并且每个工作表中以单元格A1开头的数据在第一行的每个工作表中都包含列名，其他行都有数据，但我的问题是如何获取和附加第一行来自第一个工作表，然后，第二行应该附加来自第一行第二页的内容，第三行应该附加为来自第三页第一行的下一行，并以这种方式继续，感谢您的帮助。它还假设行或列中没有间隙。这是我能看到的唯一能阻止代码工作的东西。这对我来说很好。您可能需要逐步检查代码，以检查当它尝试从其他工作表复制时会发生什么情况。您将能够看到正在复制的范围。工作表的行/列中没有任何空格/间隙，但仍然无法从此代码中获得正确的输出。如果您有任何示例文件，请将其附加到最终结果

Public Sub MergeTabs()

'Merges selected tabs (or all visible tabs if only 1 selected) in current workbook into a new tab

Dim i As Integer, wb As Workbook, w As Window, wsTo As Worksheet, wsFrom As Collection   'Worksheet collection
Dim strScope As String, strNewTab As String
Dim raTarget As Range

Set wb = ActiveWorkbook
Set w = ActiveWindow

Set wsFrom = New Collection

If w.SelectedSheets.Count = 1 Then
    For i = 1 To wb.Worksheets.Count
        If wb.Worksheets(i).Visible Then wsFrom.Add wb.Worksheets(i)
    Next
    strScope = "ALL VISIBLE"
Else
    For i = 1 To w.SelectedSheets.Count
        If w.SelectedSheets(i).Visible Then wsFrom.Add w.SelectedSheets(i)
    Next
    strScope = wsFrom.Count & " SELECTED"
End If

strNewTab = InputBox("Merge data from " & strScope & " sheets to new sheet named:", "Merge tabs", "All")
If strNewTab = vbNullString Then Exit Sub

Set wsTo = wb.Worksheets.Add(wsFrom(1), Count:=1) 'Add before first selected sheet
wsTo.Name = strNewTab

wsFrom(1).Range("A1").CurrentRegion.Copy
wsTo.Range("A1").PasteSpecial xlPasteFormulasAndNumberFormats
Application.CutCopyMode = False

For i = 2 To wsFrom.Count
    wsFrom(i).Range("A1").CurrentRegion.Copy
    wsTo.Cells(wsTo.Cells.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
    Application.CutCopyMode = False
Next i

wsTo.Range("A1").Select

MsgBox "Merge Done"

End Sub