Excel VBA：将多个工作表合并为一个答案

【问题标题】：Excel VBA: combine multiple worksheets into oneExcel VBA：将多个工作表合并为一个
【发布时间】：2019-01-21 11:16:56
【问题描述】：

我使用以下代码来组合多个工作表。问题是，此代码适用于在第一行有标题的工作表，而我的工作表没有。只能选择 3 列（A、F 和 G）。我的意思是工作表中的范围？工作表具有相同的结构，只是行数可能不同。任何的想法？谢谢！

Sub Combine()
Dim J As Integer
On Error Resume Next
Sheets(1).Select
Worksheets.Add ' add a sheet in first place
Sheets(1).Name = "Combined"
' copy headings
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
' work through sheets
For J = 2 To Sheets.Count ' from sheet 2 to last sheet
    Sheets(J).Activate ' make the sheet active
    Range("A1").Select
    Selection.CurrentRegion.Select ' select all cells in this sheets
    ' select all lines except title
    Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
    ' copy cells selected in the new sheet on last line
    Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
End Sub

【问题讨论】：

注意：删除On Error Resume Next！它隐藏了所有错误消息，但错误仍然发生，您只是看不到它们。就像闭上眼睛一样。看不到的错误无法修复！ • 您可能会受益于阅读How to avoid using Select in Excel VBA
此外，您实际上在问什么也很不清楚。请更清楚，可能屏幕截图可能有助于解释您要做什么。
例如：我有 3 张工作表：A、B 和 C。工作表 A 在第 1 行和第 2 行之间有数据，B 在第 1 行和第 3 行之间，C 仅在第 1 行。数据列是 A， B....G.我只想在示例 6 行中创建另一个包含来自 A、B、C... 的数据的工作表（组合）。而且我只想复制新组合表中的 F 行和 G 行。
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select 这部分是你需要看的，目前所有的行都被选中。您还没有说每张纸的行号来自哪里，也没有展示您自己的尝试。也不需要任何选择。
@Nathan_Sav 事实上，我可以删除这一行，但什么也没有发生。我不知道行数，每张纸都有不同的数字。我的意思是，行数可能相差很大。使用上面的代码，“组合”文件仅包含每张纸的第一行，而不是所有行。知道如何解决这个问题吗？

标签： excel vba

【解决方案1】：

您可以从结果表中删除所有不需要的列，而不是只复制 A、F+G。

Sub Combine()
Dim jCt As Integer
Dim ws As Worksheets
Dim myRange As Range
Dim lastRow As Long
lastRow = 1

'Delete Worksheet combine if it exists
If sheetExists("Combined") Then
    Application.DisplayAlerts = False
    Sheets("Combined").Delete
    Application.DisplayAlerts = True
    MsgBox "Worksheet ""Combined"" deleted!"
End If

Worksheets.Add ' add a sheet in first place
Sheets(1).Name = "Combined"

' work through sheets
For jCt = 2 To Sheets.Count ' from sheet 2 to last sheet

    Set myRange = Sheets(jCt).Range(Sheets(jCt).Cells(1, 1), Sheets(jCt).Range("A1").SpecialCells(xlCellTypeLastCell))
    Debug.Print Sheets(jCt).Name, myRange.Address

    'Put the SheetName on the Sheet "Cominbed"
    Sheets("Combined").Range("A1").Offset(lastRow, 0) = Sheets(jCt).Name
    With Sheets("Combined").Range("A1").Offset(lastRow, 0).Font
        .Bold = True
        .Size = 14
    End With

    'copy the sheets
    myRange.Copy Destination:=Sheets("Combined").Range("A1").Offset(lastRow + 2, 0)
    lastRow = lastRow + myRange.Rows.Count + 3

Next
End Sub


Function sheetExists(sheetToFind As String) As Boolean
    sheetExists = False
    For Each Sheet In Worksheets
        If sheetToFind = Sheet.Name Then
            sheetExists = True
            Exit Function
        End If
    Next Sheet
End Function

【讨论】：