Question

我正在尝试根据条件将指定范围的单元格从一张纸（Sheet2）复制到另一张图纸（Sheet1）的指定单元格。有数百行数据，我想查看每一行的VBA代码，如果满足该行的条件，则将指定的单元格范围从sheet2复制到sheet1。并不是要复制整个行，而是一行中只有四个单元格，还有更多包含数据的单元格。

更具体地说，如果每行AK列中的值大于0，我想为每行（从第2行开始）复制B到E列。我希望将此数据粘贴到在工作表1的B到E列中，从第8行开始。因此，例如，如果工作表2的第2行符合条件，我希望将工作表2中的B2到E2复制到工作表1中的B8到E8。

我试图改写在StackOverFlow和其他资源上的其他问题中找到的代码，但是我对VBA还是很陌生，但是没有成功。任何帮助将不胜感激。

Answer 1

Private Sub CopySomeCells()
    Dim SourceSheet As Worksheet
    Dim DestinationSheet As Worksheet
    Dim SourceRow As Long
    Dim DestinationRow As Long

    Set SourceSheet = ActiveWorkbook.Sheets(2)
    Set DestinationSheet = ActiveWorkbook.Sheets(1)

    DestinationRow = 8
    For SourceRow = 2 To SourceSheet.UsedRange.Rows.Count
        If SourceSheet.Range("AK" & SourceRow).Value > 0 Then
            SourceSheet.Range(SourceSheet.Cells(SourceRow, 2), SourceSheet.Cells(SourceRow, 5)).Copy _
                DestinationSheet.Cells(DestinationRow, 2)
            DestinationRow = DestinationRow + 1
        End If
    Next SourceRow
    Application.CutCopyMode = False

    Set SourceSheet = Nothing
    Set DestinationSheet = Nothing
End Sub

如果您只想粘贴值（而不是格式），则可以这样更改两行：

SourceSheet.Range(SourceSheet.Cells(SourceRow, 2), SourceSheet.Cells(SourceRow, 5)).Copy
DestinationSheet.Cells(DestinationRow, 2).PasteSpecial Paste:=xlPasteValues

或者以此更好（更快且没有剪贴板）

DestinationSheet.Cells(DestinationRow, 2).Resize(1, 4).Value = _
    SourceSheet.Cells(SourceRow, 2).Resize(1, 4).Value

如何根据列值在工作表之间复制范围？

1 个答案: