vba - 复制同一行不同列的单元格，然后粘贴到另一张纸上同一行的不同列

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