多张表格合并为一张，不包括几张表格。错误答案

【问题标题】：Multiple Sheets merged into one excluding few sheets. Error多张表格合并为一张，不包括几张表格。错误
【发布时间】：2015-09-14 08:21:23
【问题描述】：

我已经运行了这个宏，但是它正在复制每个可用的工作表，即使我已经提到不要复制特定的工作表。

Sub Combine()

Dim J As Integer
Dim ws As Worksheet

On Error Resume Next

If ws.Name <> "Invoicing" And ws.Name <> "Master Data" Then
    Sheets(1).Select
    Worksheets.Add
    Sheets(1).Name = "Combined"
    Sheets(2).Activate
    Range("A1").EntireRow.Select
    Selection.Copy Destination:=Sheets(1).Range("A1")
End If
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

End Sub

【问题讨论】：

标签： excel merge

【解决方案1】：

您已将 ws 定义为工作表，但尚未指定哪个工作表，然后循环浏览除第一个工作表之外的每个工作表。

试试这个代码 - 它循环遍历每个工作表，但忽略某些命名的工作表。

Sub Combine()

Dim ws As Worksheet
Dim shtMaster As Worksheet
Dim rTargetLastCell As Range
Dim rSourceLastCell As Range

Set shtMaster = ThisWorkbook.Worksheets("Master Data")

'Cycle through each worksheet in the workbook.
'NB: Worksheets exclude chart sheets and macro sheets.
For Each ws In ThisWorkbook.Worksheets
    Select Case ws.Name
        Case "Invoicing", "Master Data"
            'Do Nothing
        Case Else
            'Find the last cell containing data in the two sheets.
            Set rTargetLastCell = LastCell(ThisWorkbook.Worksheets("Master Data"))
            Set rSourceLastCell = LastCell(ws)

            'Copy and paste the relevant data.
            With ws
                .Range(.Cells(2, 1), rSourceLastCell).Copy _
                    Destination:=shtMaster.Cells(rTargetLastCell.Row + 1, 1)
            End With
    End Select
Next ws

End Sub

Public Function LastCell(wrkSht As Worksheet) As Range

    Dim lLastCol As Long, lLastRow As Long

    On Error Resume Next

    With wrkSht
        lLastCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
        lLastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row

        If lLastCol = 0 Then lLastCol = 1
        If lLastRow = 0 Then lLastRow = 1

        Set LastCell = .Cells(lLastRow, lLastCol)
    End With
    On Error GoTo 0

End Function

【讨论】：