1

コミュニティへようこそ。よろしくお願いします。可変数のワークシートを含むワークブックを作成しましたが、そのほとんどは可変名です。ただし、変更されないワークシートが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
4

1 に答える 1

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
于 2012-12-05T15:04:08.497 に答える