Question

欢迎社区，并提前感谢您的协助。我创建了一个工作簿，其中包含可变数量的工作表，其中大多数工作表具有变量名称。但是，有4个工作表不会改变，我不希望从中复制数据。我正在尝试的代码如下：如果我离开基地，请告诉我。

V / R 道格

Private Sub GroupReport_Click()

Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim CopyRng As Range
Dim Disreguard(1 To 4) As String

Disreguard(1) = "RDBMergeSheet"
Disreguard(2) = "0 Lists"
Disreguard(3) = "0 MasterCrewSheet"
Disreguard(4) = "00 Overview"

   ' Delete the summary sheet if it exists.
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True

' Add a new summary worksheet.
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "RDBMergeSheet"


' Loop through all worksheets and copy the data to the
' summary worksheet.
For Each sh In ActiveWorkbook.Worksheets
        If sh.Name <> Disreguard.Worksheets.Name Then
        Last = LastRow(DestSh)
        Set CopyRng = sh.Rows("21")
        CopyRng.Copy
        With DestSh.Cells(Last + 1, "A")
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
        End With

    End If
Next

Answer 1

不幸的是，这行不适合您：

If sh.Name <> Disreguard.Worksheets.Name Then

Disreguard变量是一个数组，但不是VBA中的对象，因此没有可以使用点运算符访问的方法。您必须遍历数组的内容并根据您正在测试的字符串检查每个项目。

您可以添加一个功能来测试它：

Private Function toDisreguard(ByRef list() as String, ByRef searchString As String) As Boolean
    Dim i As Long
    For i = LBound(list) To UBound(list)
        If (searchString = list(i)) Then
            toDisreguard = True
            Exit Function
        End If
    Next i

    toDisreguard = False
End Function

然后将数组与工作表名称一起传递给测试，如下所示：

If (toDisreguard(Disreguard, sh.Name) = False) Then

此外，LastRow（）函数未根据您发布的内容定义。这是你创建的一个功能吗？

事实上，您可以自己跟踪最后一行，因为每次运行时都会重建“RDBMergeSheet”工作表。您可以从设置Last = 1开始，然后沿途增加。最后一件事，您应该测试每个工作表中第21行是否有任何数据，这样您就不会复制空行：

' Loop through all worksheets and copy the data to the
' summary worksheet.
Last = 1

For Each sh In ActiveWorkbook.Worksheets
    If (toDisreguard(Disreguard, sh.Name) = False) Then
        'Last = LastRow(DestSh)
        If (Application.WorksheetFunction.CountA(sh.Rows("21")) > 0) Then
            Set CopyRng = sh.Rows("21")
            CopyRng.Copy
            With DestSh.Cells(Last, "A") ' notice i changed this as well
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With
            Last = Last + 1
        End If
    End If
Next

从工作簿中的工作表子集复制数据并粘贴到主工作表，忽略标准主题表

1 个答案: