复制同一行中不同列的单元格，并粘贴到另一个工作表上同一行的不同列

Question

我已经成功编写了代码，可以复制一个单元格，粘贴到另一个页面上的单元格中，然后再冲洗另外3个列的冲洗重复。 见下文：

Sub Click()

Dim amattuid As String
Dim finalrow As Integer
Dim i As Integer


Application.ScreenUpdating = False

Sheets("Buckhalter VB").Range("A6:G200").ClearContents

amattuid = Sheets("Buckhalter VB").Range("B3").Value
finalrow = Sheets("Current Heirarchy").Range("BM2000").End(xlUp).Row
repattuid = Sheets("Buckhalter VB").Range("A6").Value

For i = 4 To finalrow
    If Sheets("Current Heirarchy").Cells(i, 65) = amattuid Then
        Sheets("Current Heirarchy").Cells(i, 46).Copy
        Sheets("Buckhalter VB").Range("A200").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        Sheets("Current Heirarchy").Cells(i, 2).Copy
        Sheets("Buckhalter VB").Range("B200").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        Sheets("Current Heirarchy").Cells(i, 48).Copy
        Sheets("Buckhalter VB").Range("C200").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        Sheets("Current Heirarchy").Cells(i, 49).Copy
        Sheets("Buckhalter VB").Range("G200").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
Next i

Application.ScreenUpdating = True

End Sub

这有效，但我想知道是否有办法简化它。 因此，它会立即复制所有单元格，然后立即将它们粘贴到指定位置。

Answer 1

试试这个 ：

Sub Click()

Dim amattuid As String
Dim finalrow As Integer
Dim i As Integer


Application.ScreenUpdating = False

Sheets("Buckhalter VB").Range("A6:G200").ClearContents

amattuid = Sheets("Buckhalter VB").Range("B3").Value
finalrow = Sheets("Current Heirarchy").Range("BM2000").End(xlUp).Row
repattuid = Sheets("Buckhalter VB").Range("A6").Value

For i = 4 To finalrow
    If Sheets("Current Heirarchy").Cells(i, 65) = amattuid Then
        Sheets("Buckhalter VB").Range("A200").End(xlUp).Offset(1, 0) = Sheets("Current Heirarchy").Cells(i, 46).Value
        Sheets("Buckhalter VB").Range("B200").End(xlUp).Offset(1, 0) = Sheets("Current Heirarchy").Cells(i, 2).Value
        Sheets("Buckhalter VB").Range("C200").End(xlUp).Offset(1, 0) = Sheets("Current Heirarchy").Cells(i, 48).Value
        Sheets("Buckhalter VB").Range("G200").End(xlUp).Offset(1, 0) = Sheets("Current Heirarchy").Cells(i, 49).Value
        End If
Next i

Application.ScreenUpdating = True

End Sub