如果符合条件，则从一个工作簿复制到另一个工作簿

Question

我正在尝试将满足条件的行从一个工作簿复制到另一个工作簿。

在我的Workbook1中，我想查找第8列，如果它有“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