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

 

[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

Hello again
Tonight I tried to finish my project and noticed one error with paste due to formulas used
Any chance to modify macro to paste data in Values and Source formatting to avoid copy formulas?
I believe this is xlPasteValuesAndNumberFormats

 

[kevin9999]

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).PasteSpecial xlPasteValuesAndNumberFormats
   Application.CutCopyMode = False
End Sub

 

[Josu]

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).PasteSpecial xlPasteValuesAndNumberFormats
   Application.CutCopyMode = False
End Sub

Almost what I need
Any chance to do this and keep colour formating
For the first one I did

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

Basically need both, xlPasteFormats and xlPasteValuesAndNumberFormats

 

[kevin9999]

I'm away from my laptop at the moment so this is untested, but 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
   With ws2.Cells(Rows.Count, 1).End(xlUp).Offset(2)
      .PasteSpecial xlPasteValuesAndNumberFormats
      .PasteSpecial xlPasteFormats
   Application.CutCopyMode = False
   End With
End Sub

 

[Josu]

You genius, that worked like a charm
I wish to learn vba like this Will be very useful for my work