Geek Answers Handbook

Copy cells from different columns into one row and paste them into different columns in one row on another sheet

I successfully wrote the code that will copy the cell, paste it into the cell on another page, and then flush the retry again for the rest of the columns. See below:

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

This works, but I am wondering if there is a way to arrange it. Thus, it copies all the cells at once, and then pastes them immediately into the designated places.

+4
source share
1 answer

Try the following:

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
+1
source

More articles:


All Articles