VBA - Paste tables under each other with 1 lane space between

[Josu]

I currently have small project and I trying to figure out how to paste to "Dynamic Range" inserting 1 lane of space between pasted date
Basically location to paste always will be moved either up or down

Sub CopyTest()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Test")
ws.Activate
With ThisWorkbook.Worksheets("Test")
Dim lr As Long
'   Find last row in column A with data
    lr = Cells(Rows.Count, "A").End(xlUp).Row
'   Copy range
    Range("A1:G" & lr).copy
End With

End Sub

Sub PasteTest()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Email")
ws.Activate
With ThisWorkbook.Worksheets("Email")
Range("A1").PasteSpecial xlPasteAll
End With
End Sub

Basically I need 1 lane of space after last cell with data in column A

 

[Skyybot]

Try this. A small change to your code.

Sub CopyTest()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Test")
ws.Activate
With ThisWorkbook.Worksheets("Test")
Dim lr As Long
'   Find last row in column A with data
    lr = Cells(Rows.Count, "A").End(xlUp).Row
'   Copy range
    Range("A1:G" & lr).copy
End With

End Sub

Sub PasteTest()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Email")
ws.Activate
With ThisWorkbook.Worksheets("Email")
Range(ws.Cells(ws.UsedRange.Rows.Count) + 1, 1)).PasteSpecial xlPasteAll
End With
End Sub

 

[Josu]

Try this. A small change to your code.

Thank you for response. Unfortunately I am getting syntax error in row starting with Range

 

[Josu]

Actually second part of code which I using, copied wrong part initially and can't edit main message now

Sub PasteTest()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Email")
ws.Activate
With ThisWorkbook.Worksheets("Email")
Dim lr As Long
'   Find last row in column A with data
    lr = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & lr).PasteSpecial xlPasteAll
End With
End Sub

 

[Josu]

Anyone can help with this?
Still cannot figure out how to win this fight

 

[kevin9999]

If I understand you correctly, you want to copy a 'table' (probably a range?) from the sheet "Test" from A1 to the last row in column G, and paste it to the sheet "Email" under some existing data? If that's it, try the following:

Option Explicit
Sub CopyUnder()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("Test")
    Set ws2 = Worksheets("Email")
    
    ws1.Range("A1", ws1.Cells(Rows.Count, "G").End(xlUp)).Copy _
    ws2.Cells(Rows.Count, 1).End(xlUp).Offset(2)
End Sub

 

[Josu]

If I understand you correctly, you want to copy a 'table' (probably a range?) from the sheet "Test" from A1 to the last row in column G, and paste it to the sheet "Email" under some existing data? If that's it, try the following:

Option Explicit
Sub CopyUnder()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("Test")
    Set ws2 = Worksheets("Email")
  
    ws1.Range("A1", ws1.Cells(Rows.Count, "G").End(xlUp)).Copy _
    ws2.Cells(Rows.Count, 1).End(xlUp).Offset(2)
End Sub

Basically with copy there is no issue
Problem is with PASTE after, as I need to have extra row of space between as I repeat this paste 3 times in same sheet

Sub PasteTest()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Email")
ws.Activate
With ThisWorkbook.Worksheets("Email")
Dim lr As Long
'   Find last row in column A with data
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    Range("A" & lr).PasteSpecial xlPasteAll
End With
End Sub

In this code I need somehow to paste not in last row with data, but last row with data +1 row (to have empty space)

 

[kevin9999]

Yes. Try the code in post #6. It does do that.

 

[Josu]

Yes. Try the code in post #6. It does do that.

Thank you, I did some weird edits
Your solution is way better
Thank you very much!

 

[kevin9999]

Thank you, I did some weird edits
Your solution is way better
Thank you very much!

Happy to help, and thanks for the feedback