根据列值将行复制到新工作簿中

Question

我目前正在动态创建新工作簿，并且想知道如果满足某些条件，您是如何复制数据的，即在这种情况下，如果主要联系人=约翰和主要设备=桌面然后复制ID，首先名称，姓氏和电子邮件列到刚刚在列/行 A11以后，B11以后，C11以后，D11以后创建的新工作簿中（取决于拉取的数据量）。这可能吗？

到目前为止，这是我的代码：

Sub NewWb()

' Create new workbook with a pre-defined name
Workbooks.Add
NewBook = ActiveWorkbook.Name
ThisWorkbook.Activate
Workbooks(NewBook).Activate

' Set bg to white
ActiveWorkbook.Sheets("Sheet1").Cells.Interior.ColorIndex = 2

' Sanity test
'MsgBox (ThisWorkbook.Sheets("Master").Cells(3, 3).Value)
'MsgBox (ActiveWorkbook.Sheets("Sheet1").Cells(7, 1).Value)

' Get last row
LastRow = ThisWorkbook.Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row

' Pull out relevant data from master spreadsheet where column F = "John"
With ThisWorkbook.Sheets("Master")
    .AutoFilterMode = False
    .Range("A2:Z2").AutoFilter Field:=6, Criteria1:="John"
    ' Copy and paste NBK
    .Range("A2:A" & LastRow).Copy
        ActiveWorkbook.Sheets("Sheet1").Range ("A11")
End With

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationAutomatic

End Sub

Answer 1

把它弄出来！

With ThisWorkbook.Sheets("Master")
    .AutoFilterMode = False
    .Range("A2:Z2").AutoFilter Field:=6, Criteria1:="John"
    .Range("A2:Z2").AutoFilter Field:=8, Criteria1:="Desktop"
    ' Copy and paste NBK, first name, last name
    .Range("A3:C" & LastRow).Copy
        ActiveWorkbook.Sheets("Sheet1").Range("A" & NextHeaderRow + 5).PasteSpecial xlPasteValues
    ' Copy and paste email
    .Range("E3:E" & LastRow).Copy
        ActiveWorkbook.Sheets("Sheet1").Range("D" & NextHeaderRow + 5).PasteSpecial xlPasteValues
End With