![](/img/trans.png)
[英]How to copy specific columns from one sheet and paste in another sheet in a different range at the first row?
[英]Copy cells from different columns on same row, and paste to different columns on same row on another sheet
我已經成功編寫了代碼,可以復制一個單元格,粘貼到另一個頁面上的單元格中,然后再沖洗另外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
這有效,但我想知道是否有辦法簡化它。 因此,它會立即復制所有單元格,然后立即將它們粘貼到指定位置。
試試這個 :
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
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.