时间戳

首页 > 解决方案 > 如果满足某些条件，则在工作表之间复制数据

excel - 如果满足某些条件，则在工作表之间复制数据

问题描述

我想通过 D 列，如果有一个“是”，则复制一些单元格，这些单元格与 D 列中显示“是”的单元格的距离始终相同。

例如，如果 D23 说“是”，则将 A23、A24、B22 和 E22 并排复制到另一张纸中。

我记录了下面的代码。我将宏附加到一个按钮上。如果我滚动到 D 列中具有“是”的单元格并单击按钮，它会执行我想要的操作。我不知道如何让它在整个 D 列中自行运行代码。

此外，它粘贴在信息的一侧。有没有办法在先前粘贴的数据下方粘贴新工作表，因为目前行之间有很多空白空间，因为“是”仅每 20 行左右出现一次。

Sub Test()  
 ' Test Macro

Range("A23").Select
Selection.Copy
Range("V23").Select
ActiveSheet.Paste
Range("A24").Select
Application.CutCopyMode = False
Selection.Copy
Range("W23").Select
ActiveSheet.Paste
Range("B22").Select
Application.CutCopyMode = False
Selection.Copy
Range("Y23").Select
ActiveSheet.Paste
Range("E22").Select
Application.CutCopyMode = False
Selection.Copy
Range("Z23").Select
ActiveSheet.Paste  

End Sub

标签： excelvba

解决方案

因为您至少尝试过，所以我建议以下内容。

有一个For循环遍历所有包含数据的行并检查“是”。如果有，则将数据复制到目标工作表中。

Option Explicit

Public Sub FindKeywordAndCopyData()
    Dim wsSource As Worksheet
    Set wsSource = ThisWorkbook.Worksheets("Data") 'define data sheet

    Dim wsDestination As Worksheet
    Set wsDestination = ThisWorkbook.Worksheets("Output") 'define output sheet

    Dim LastRow As Long
    LastRow = wsSource.Cells(Rows.Count, "D").End(xlUp).Row 'find last used row in column D

    Dim NextFreeRow As Long

    Dim iRow As Long
    For iRow = 2 To LastRow 'loop through all data rows (from row 2 to last used row)
        If wsSource.Cells(iRow, "D").Value = "yes" Then 'check if column D has a "yes"
            With wsDestination
                NextFreeRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 'find next empty row in destination sheet

                'copy the cell values to destination A, B, C, D
                .Cells(NextFreeRow, "A").Value = wsSource.Cells(iRow, "A").Value     'current row column A
                .Cells(NextFreeRow, "B").Value = wsSource.Cells(iRow + 1, "A").Value 'next row column A
                .Cells(NextFreeRow, "C").Value = wsSource.Cells(iRow - 1, "B").Value 'previous row column B
                .Cells(NextFreeRow, "D").Value = wsSource.Cells(iRow - 1, "E").Value 'previous row column E
            End With
        End If
    Next iRow
End Sub

推荐阅读