Цикл и вставка между книгами с VBA

Question

Мне нужно скопировать и вставить значения из рабочей книги 1 в рабочую книгу 2, если в последнем столбце рабочей книги 1 указано «да».

Затем мне нужно перейти к следующей строке в рабочей книге 1 и вставитьзначения в новую рабочую таблицу в рабочей книге 2 и делайте то же самое, пока в последнем столбце рабочей книги 1 больше не будет указано «да».

Пока у меня есть следующий код.Как сделать цикл между строками в книге 1?

Dim InputFile As Workbook
Dim OutputFile As Workbook
'other code here not relevant 
Set InputFile = Workbooks.Open(filepath)
Set OutputFile = ThisWorkbook

Dim Lastname As String
Dim Firstname As String
Dim InvEntityname As String
Dim Commitment As Long
Dim InvoiceAmount As Long

Dim Col As Range

For Each Col In Range("U5", Range("U" & Rows.Count).End(xlUp))
        If Col.Value = "Yes" Then

        Lastname = ActiveCell.Offset(1, 0)
        Firstname = ActiveCell.Offset(1, 1)
        InvEntityname = ActiveCell.Offset(1, 2)
        Commitment = ActiveCell.Offset(1, 6)
        InvoiceAmount = ActiveCell.Offset(1, 15)

 ThisWorkbook.Sheets(1).Activate
        Range("c24") = Lastname
        Range("D24") = Firstname
        Range("B13") = InvEntityname
        Range("E41") = Commitment
        Range("G41") = InvoiceAmount

End If
    Next Col

ActiveSheet.Name = Range("b13")
Worksheets.Copy After:=ActiveSheet

Answer 1

Rows To Sheets

Так как здесь много догадок, будьте осторожны, как использовать его, чтобы не потерять данные.

Этот код открывает рабочую книгу и на ее Activesheet проходит по столбцу Uи каждый раз, когда он находит «Да», из найденной строки копирует некоторые ячейки на первый (1) лист ThisWorkbook, затем создает копию листа сразу после него и переименовывает копию;таким образом создавая столько таблиц, сколько найдено "Да" - и.

Option Explicit

Sub RowsToSheets()

  Dim wsInput As Worksheet
  Dim Col As Range

  'other code here not relevant

  Set wsInput = Workbooks.Open(filepath).ActiveSheet

  For Each Col In wsInput.Range("U5" & ":" _
      & wsInput.Range("U" & Rows.Count).End(xlUp).Address)

    If Col.Value = "Yes" Then

      With ThisWorkbook.Worksheets(1)

        ' Copy data from found row to ws.
        .Range("C24") = Col.Offset(1, 0)   ' Lastname
        .Range("D24") = Col.Offset(1, 1)   ' Firstname
        .Range("B13") = Col.Offset(1, 2)   ' InvEntityname
        .Range("E41") = Col.Offset(1, 6)   ' Commitment
        .Range("G41") = Col.Offset(1, 15)  ' InvoiceAmount

        ' Create a copy after itself.
        .Copy after:=.Parent.Worksheets(1)

'        ' I Would prefer here after the last worksheet: 
'        .Copy after:=.Parent.Worksheets(.Parent.Worksheets.Count)
'        ' Rename the copy.
'        .Parent.Worksheets(.Parent.Worksheets.Count).Name = .Range("B13")     

        ' Rename the copy.
        .Parent.Worksheets(.Index + 1).Name = .Range("B13")

      End With

    End If

  Next

  Set Col = Nothing
  Set wsInput = Nothing

End Sub