如果符合條件，則從一個工作簿復制到另一個工作簿

Question

我試圖將滿足我條件的行從一個工作簿復制到另一個工作簿。

在我的Workbook1中，我想查找8TH Column，如果它具有“ TRU”，那么我想將整個副本復制到工作表名稱為“ Pivottable”的另一個新工作簿中，並以.xlsx格式保存。

到目前為止，我已經嘗試了以下代碼，但出現錯誤

下標超出范圍

Sub OpenBook()
    Dim MyBook As Workbook, newBook As Workbook
    Dim FileNm As String
    Dim LastRow As Long
    Dim i As Long, j As Long

    Set MyBook = ThisWorkbook

    FileNm = ThisWorkbook.Path & "\" & "ProjectList.xlsx"
    Set newBook = Workbooks.Add

    With MyBook
    With Worksheets("Pivottabelle")
      LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
   End With
   End With

    With newBook
    Sheets("Sheet1").Name = "PivotTable"
    With Worksheets("PivotTable")
      j = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
   End With
   End With

   With newBook
   For i = 1 To LastRow
       With Worksheets("Pivottabelle")
           If .Cells(i, 8).Value = "TRU" Then
               .Rows(i).Copy Destination:=Worksheets("PivotTable").Range("A" & j)
               j = j + 1
           End If
       End With
   Next i

        'Save new wb with XLS extension
        .SaveAs Filename:=FileNm, FileFormat:=xlNormal, CreateBackup:=True

        .Close Savechanges:=False
    End With
End Sub

編輯：錯誤對話框

Answer 1

哇， With和End With在這里有很多用途，而實際上並沒有從中受益。

我遍歷了代碼，並在我認為需要的地方對其進行了修復，但您可能需要檢查我的解釋是否正確：

Dim FileNm As String
Dim LastRow As Long
Dim i As Long, j As Long

Set MyBook = ThisWorkbook

FileNm = MyBook.Path & "\" & "ProjectList.xlsx"
Set newBook = Workbooks.Add

With MyBook.Worksheets("Pivottabelle")
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

With newBook.Sheets("Sheet1")
    .Name = "PivotTable"
    j = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With

With MyBook.Worksheets("Pivottabelle")
    For i = 1 To LastRow
        If .Cells(i, 8).Value = "TRU" Then
            .Rows(i).Copy Destination:=newBook.Worksheets("PivotTable").Range("A" & j)
            j = j + 1
        End If
    Next i
End With

With newBook
    'Save new wb with XLS extension
    .SaveAs Filename:=FileNm, FileFormat:=xlNormal, CreateBackup:=True
    .Close Savechanges:=False
End With