CODEWITHSUNDEEP
vbaexcelexcel-2016
quantamz
quantamz

Reputation: 23

Excel VBA Copy and Paste to last row

A complete beginner with Excel VBA here. I want to be able to copy and paste a chunk of information from one cell in one row to cells in another row. For example a chunk of information from Row "A" to Row "F". However I want to be able to do this multiple times even after i have already run the macro once and i want the information to be pasted below the last used cell of Row "F", so the list can be continued. I want to paste the information with no lines between each column when I run the macro multiple times but I want it to start from a specific column. However I can't seem to do it.

Here is my code:

Sub pastebelowlastcell()
Dim lRow As Long
Dim LastRow As Long
lRow = Sheets("Sheet1").Cells(Rows.Count,"A").End(xlUp).Row
lRow = lRow + 1
LastRow = Sheets("Sheet1").Cells(Rows.Count,"F").End(xlUp).Row
LastRow = LastRow + 1
ActiveSheet.Range("A1:C" & lRow).Copy
ActiveSheet.Range("F" & LastRow).PasteSpecial
Application.CutCopyMode = False
End sub

For example, I want to paste the code starting from "F10" but if i change my code to:

LastRow = Sheets("Sheet1").Cells(Rows.Count,"F").End(xlUp).Row
LastRow = LastRow + 9

It will paste starting from "F10", but it will paste with 8 blank lines in between each time it pastes, when I run the code multiple times.

Also, is it possible to be able to paste the information from single cells into merged cells using this method?

Upvotes: 1

Views: 30915

Answers (2)

SJR
SJR

Reputation: 23081

Try changing the LastRow line to 

LastRow = WorksheetFunction.Max(Sheets("Sheet1").Cells(Rows.Count, "F").End(xlUp).Row, 9)

When you start it will be assigned the value of 9 (before you add 1) and henceforth it will find the last used row.

Upvotes: 1

user8608712
user8608712

Reputation:

Assuming that you start copying from Row 1 of Column A, try this:

Sub pastebelowlastcell()

Dim FirstRow, ALastRow, FLastRow As Long

t = 1
ALastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

    Do Until t = ALastRow

        ActiveSheet.Range("A" & t & ":C" & t).Copy

        FLastRow = ActiveSheet.Cells(Rows.Count, 6).End(xlUp).Row
        If t = 1 Then FLastRow = 10

        ActiveSheet.Range("F" & FLastRow).PasteSpecial Paste:=xlPasteValues

        t = t + 1

    Loop

Application.CutCopyMode = False

End Sub

Upvotes: 0

Related Questions