CODEWITHSUNDEEP
excelvba
jh144
jh144

Reputation: 25

Copy and Paste row values into next empty row

I am trying to copy the same row of information from a sheet called "Report" (numbers will change), and paste the values into a sheet "Data" that has headers in the first row.

I tried piecing together some code from various questions.

Here is my code:

Sub Insert_Data()
'
' Insert_Data Macro
Sheets("Report").Range("B9:F9").Copy
Sheets("Data").Range("A1").PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

Sub PSData_Transfer()

Sheets("Report").Range("B9:F9").Copy

Dim lastrow As Long
lastrow = Sheets("Data").Range("A65536").End(xlUp).Row

Sheets("Data").Activate
Cells(lastrow + 1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

End Sub

Upvotes: 1

Views: 3675

Answers (1)

Maldred
Maldred

Reputation: 1104

You may have to modify this a little bit to work with your code, but feel free to use mine that I'm using in my current worksheet and it works perfect!

Sub Insert_Data()

    For R = LR To 2 Step -1   ' Change the 2 in "To 2" to the row just below your header,
                              ' but typically row 2 is the second cell under header anyways
        Call CopyTo(Worksheets(2).Range("B" & R & ":C" & R), Worksheets(1)Range("A:B"))
    Next R

End Sub

Private Function CopyTo(rngSource As Range, rngDest As Range)

    LR = rngDest.cells(Rows.Count, 1).End(xlUp).row

    rngDest.cells(LR + 1, 1).value = rngSource.cells(1, 1).value
    rngDest.cells(LR + 1, 2).value = rngSource.cells(1, 2).value

End Function

I don't like to use the copy method as it's slow and it likes to copy all the extra jargin, where as getting the value is much faster and it's retrieving ONLY the value

Upvotes: 1

Related Questions