如果满足条件，则 VBA 代码复制粘贴多个单元格答案

【问题标题】：VBA Code Copy Paste Multiple Cells if Condition is Met如果满足条件，则 VBA 代码复制粘贴多个单元格
【发布时间】：2021-08-25 22:40:59
【问题描述】：

我正在寻求帮助，将满足源数据表中要求的特定单元格复制并粘贴到“仪表板”表中。我有下面的代码，但是当我运行宏时，它只复制并粘贴符合条件的最后一行，而不是所有符合条件的行。

作为参考，我从源数据表上的表格中的一行复制 3 个单元格，这些单元格的大小可能会在任何一天增加或减少，并将这 3 个单元格粘贴到仪表板表中不同表格的底部.

感谢任何帮助，谢谢！

Sub CopyPaste()

Dim SourceData As Worksheet
Dim Dashboard As Worksheet

Dim searchString As String

Dim lastSourceRow As Long
Dim startSourceRow As Long
Dim lastTargetRow As Long
Dim sourceRowCounter As Long
Dim columnToEval As Long
Dim columnCounter As Long

Dim columnsToCopy As Variant
Dim columnsDestination As Variant


Set SourceData = ThisWorkbook.Worksheets("Source Data")
Set Dashboard = ThisWorkbook.Worksheets("Dashboard")


columnsToCopy = Array(7, 8, 11)
columnsDestination = Array(2, 3, 4)


searchString = "New"


startSourceRow = 3


columnToEval = 45


lastSourceRow = SourceData.Cells(SourceData.Rows.Count, 1).End(xlUp).Row

For sourceRowCounter = startSourceRow To lastSourceRow

        If SourceData.Cells(sourceRowCounter, columnToEval).Value = searchString Then

          
            lastTargetRow = Dashboard.Cells(Dashboard.Rows.Count, 1).End(xlUp).Row

            For columnCounter = 0 To UBound(columnsToCopy)

              
                Dashboard.Cells(lastTargetRow, columnsDestination(columnCounter)).Offset(1, 0).Value = SourceData.Cells(sourceRowCounter, columnsToCopy(columnCounter)).Value

            Next columnCounter

        End If

Next sourceRowCounter


SourceData.Activate

End Sub

【问题讨论】：

您正在填充第 2,3 和 4 列，但从第 1 列得到lastTargetRow
@TimWilliams 是正确的。我正在使用 lastTargetRow 遍历第 1 列中的所有值并获取目标工作表上的最后一行。然后使用 columnsDestination 粘贴到最后一行之后的第 2,3 和 4 列。我的问题是当我的源数据中有多行符合我的搜索字符串条件时，它不会复制和粘贴所有这些行。它只是在我的源表上抓取最后一个符合我的条件的实例并将其粘贴到我的目标表中。
不，它只是将所有行粘贴在一起，因为填充第 2-4 列不会改变 Col A 中最后一个值的位置。这就是为什么它看起来只是最后一个行被复制。一种方法是在进入搜索循环之前获取 lastTargetRow 的值，然后为每个复制的行加 1。

标签： excel vba for-loop

【解决方案1】：

根据上面的cmets：

Sub CopyPaste()

    Dim SourceData As Worksheet
    Dim Dashboard As Worksheet
    Dim searchString As String
    Dim lastSourceRow As Long
    Dim startSourceRow As Long
    Dim lastTargetRow As Long
    Dim sourceRowCounter As Long
    Dim columnToEval As Long
    Dim columnCounter As Long
    Dim columnsToCopy As Variant
    Dim columnsDestination As Variant
    
    Set SourceData = ThisWorkbook.Worksheets("Source Data")
    Set Dashboard = ThisWorkbook.Worksheets("Dashboard")
    
    columnsToCopy = Array(7, 8, 11)
    columnsDestination = Array(2, 3, 4)
    
    searchString = "New"
    startSourceRow = 3
    columnToEval = 45
    
    lastTargetRow = Dashboard.Cells(Dashboard.Rows.Count, 1).End(xlUp).Row 'move this out of the loop
    lastSourceRow = SourceData.Cells(SourceData.Rows.Count, 1).End(xlUp).Row
    
    For sourceRowCounter = startSourceRow To lastSourceRow
        If SourceData.Cells(sourceRowCounter, columnToEval).Value = searchString Then
            
            For columnCounter = 0 To UBound(columnsToCopy)
                Dashboard.Cells(lastTargetRow, columnsDestination(columnCounter)).Offset(1, 0).Value = _
                      SourceData.Cells(sourceRowCounter, columnsToCopy(columnCounter)).Value
            Next columnCounter
            lastTargetRow = lastTargetRow + 1 'next destination row
        End If
    Next sourceRowCounter
    
    SourceData.Activate

End Sub

【讨论】：