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

我已经成功地编写了代码，将复制一个单元格，粘贴到另一页上的单元格，然后清洗重复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