Copy and Paste Range to Next Available Row in Another Sheet

[Tech56]

Hello,

I have these recurring expenses every month and would like to have them copied and pasted to my Transactions sheet with VBA please.

There is a Recurring Log sheet showing these entries that need to be added to the next available row in the Transactions sheet. Does someone know how to do this?

NOTE: The 'Amazon Prime Membership' may need the formula change in cell B15 in the Recurring Log that only occurs in the month of September.

Thank you very kindly for your help

 

[AlanSidman]

Option Explicit

Sub MoveTransX()
    Dim s1 As Worksheet, s2 As Worksheet
    Set s1 = Sheets("Transactions")
    Set s2 = Sheets("Recurring Log")
    Dim i As Long, lr As Long, lr2 As Long
    lr = s1.Range("A" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    For i = 17 To lr
        If s1.Range("B" & i) <> "" Then
            s1.Range("A" & i & ":H" & i).Copy
            lr2 = s2.Range("A" & Rows.Count).End(xlUp).Row + 1
            s2.Range("A" & lr2).PasteSpecial xlPasteValues
        End If
    Next i
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "complete"
End Sub

 

[Tech56]

Thank you for the code Mr. Sidman but unfortunately it is pasting only 5 rows to the Recurring Log sheet. I need it to copy from the Recurring Log to the Transactions sheet if there is a date in the Recurring Log column B. There should be 18 rows copied.

Thank you

 

[AlanSidman]

Had the code backwards. Here is revised code. Note that this code looks for the last cell in Transactions not having data in Column A. Apparently the coding places this in the file provided as line 50 and starts to paste there. You should look to remove your formatting from Transactions Column A as this confuses the code.

Option Explicit

Sub MoveTransX()
    Dim s1 As Worksheet, s2 As Worksheet
    Set s1 = Sheets("Recurring Log")
    Set s2 = Sheets("Transactions")
    Dim i As Long, lr As Long, lr2 As Long
    lr = s1.Range("A" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    For i = 4 To lr
        If s1.Range("B" & i) <> "" Then
            s1.Range("A" & i & ":H" & i).Copy
            lr2 = s2.Range("A" & Rows.Count).End(xlUp).Row + 1
            s2.Range("A" & lr2).PasteSpecial xlPasteValues
        End If
    Next i
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "complete"
End Sub

 

[Tech56]

Thanks I tried the new code but nothing happens. Can you take a look?
I didn't realize they were being posted further down the table. It does work fine thanks.

I have a request though. Is it possible to have the code check to see if they were posted already so they don't get posted again for the same month?

I know this is above and beyond my original request but it would help in the future to avoid double entries.

I really appreciate it.