使用VBA

Question

如果工作簿1的最后一列中的“是”，我需要将工作簿1中的值复制并粘贴到工作簿2中。

然后，我需要循环到工作簿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

行到表格

由于此处涉及很多猜测，因此请谨慎使用它，以免丢失数据。

此代码打开一个工作簿，并在其Activesheet上遍历U列，并在每次找到“是”时，从找到的行中将一些单元格复制到ThisWorkbook的第一（1）张工作表中，然后右键创建该工作表的副本之后并重命名副本；因此创建的工作表的数量与“是”的数量相同。

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