时间戳

首页 > 解决方案 > 使用 VBA 在工作簿之间循环和粘贴

excel - 使用 VBA 在工作簿之间循环和粘贴

问题描述

如果工作簿 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

标签： excelvbaloops

解决方案

行到表

由于这里涉及到很多猜测，因此要小心如何使用它以免丢失数据。

此代码打开一个工作簿，并在其 Activesheet 上循环遍历 U 列，每次从找到的行中找到“是”时，将一些单元格复制到 ThisWorkbook 的第一 (1) 个工作表，然后在其后创建工作表的副本，然后重命名副本；从而创建与找到“是”-es 一样多的工作表。

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

推荐阅读