Question

我正在尝试从一个工作表中复制行，如果它们符合特定条件，则将其粘贴到另一工作表中，但是我在VBA的复制和粘贴功能中苦苦挣扎。有人可以帮我吗？

Sub Code()

Dim x, y As Range

Number_of_rows_ORIGIN = WorksheetFunction.CountA(ThisWorkbook.Worksheets("Sheet1").Cells(1, 3).EntireColumn)

For Each x In Range(ThisWorkbook.Worksheets("Sheet1").Cells(1, 3), ThisWorkbook.Worksheets("Sheet1").Cells(Number_of_rows_ORIGIN, 3))

    Nb_R_Dest = WorksheetFunction.CountA(ThisWorkbook.Worksheets("Sheet3").Cells(1, 3).EntireColumn)

    If x = ThisWorkbook.Worksheets("Sheet2").Cells(1, 1) Then
        ThisWorkbook.Worksheets("Sheet2").Rows(x.Row).Copy
        ThisWorkbook.Worksheets("Sheet3").Cells(Nb_R_Dest + 1, 1).Paste
    Else
    End If
Next x

End Sub

Answer 1

我假设您只想复制值。我对您的代码进行了一些调整，以使其看起来更干净：

Option Explicit
Sub Code()

    Dim x As Range, LastRow As Long, LastRowPaste As Long
    Dim wsPaste As Worksheet, ws As Worksheet, wsSource As Worksheet

    With ThisWorkbook 'use this to shorten your code
        Set ws = .Sheets("Sheet1")
        Set wsSource = .Sheets("Sheet2")
        Set wsPaste = .Sheets("Sheet3")
    End With

    LastRow = ws.Cells(.Rows.Count, 3).End(xlUp).Row 'This is cleaner to get the last row

    For Each x In Range(ws.Cells(1, 3), ws.Cells(LastRow, 3))
        LastRowPaste = wsPaste.Cells(wsPaste.Rows.Count, 3).End(xlUp).Row + 1
        If x = wsSource.Cells(1, 1) Then
            wsPaste.Rows(LastRowPaste).Value = wsSource.Rows(x.Row).Value
        End If
    Next x

End Sub

VBA，将行从一个工作表复制并粘贴到另一个工作表

1 个答案: