Copy Pasting Range of varying length from one worksheet to another worksheet using Excel VBA

Question

I have data that is set up to output as follows:

• 4 columns of data
• then the data is separated by 4 blank columns and then there are another 4 columns of data etc.
• The rows differ in length
• The data is pulled in from Bloomberg and so the rows may change every time the data is refreshed.
• The data starts at row 3 and column 2.

I am trying to create a loop that

• selects the entire 4 columns, copies and pastes them in another worksheet
• then moves across the 4 blank columns, copies the data and pastes it in the other worksheet right below the previously pasted data
• until the last column with data is reached.
• I'm trying to create a blank row in between each, and am also trying to keep the 4 columns next to each other when I pasted them into the new worksheet

Here is the code I am having trouble with....

Sub CopyPasteDex()

  Dim wksDest             As Worksheet
  Dim wksSource           As Worksheet
  Dim Rngsource           As Range
  Dim NextRow             As Long
  Dim LastRow             As Long
  Dim LastCol             As Long
  Dim c                   As Long

Application.ScreenUpdating = False

Set wksSource = Worksheets("Sheet1")
Set wksDest = Worksheets("Sheet2")

With wksDest
    NextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With

With wksSource
    LastCol = .Cells(3, .Columns.Count).End(xlToLeft).Column
    For c = 2 To LastCol Step 7
        LastRow = .Cells(.Rows.Count, c).End(xlUp).Row
        Set Rngsource = .Range(.Cells(3, c), .Cells(LastRow, c + 3))
        Rngsource.Copy
        wksDest.Range("A:A").PasteSpecial.xlPasteValues
        NextRow = NextRow + Rngsource.Rows.Count
    Next c
End With

Application.ScreenUpdating = True

End Sub

Answer 1

This seems to work for me.

Sub CopyPasteDex()

  Dim wksDest             As Worksheet
  Dim wksSource           As Worksheet
  Dim Rngsource           As Range
  Dim NextRow             As Long
  Dim LastRow             As Long
  Dim LastCol             As Long
  Dim c                   As Long

Application.ScreenUpdating = False

Set wksSource = Worksheets("Sheet1")
Set wksDest = Worksheets("Sheet2")

With wksDest
    NextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With

With wksSource
    LastCol = .Cells(3, .Columns.Count).End(xlToLeft).Column
    For c = 2 To LastCol Step 8    ' make sure that the step is changed to 8 here.
        LastRow = .Cells(.Rows.Count, c).End(xlUp).Row
        Set Rngsource = .Range(.Cells(3, c), .Cells(LastRow, c + 3))
        Rngsource.copy
        wksDest.Cells(NextRow, 1).PasteSpecial xlPasteValues    ' Note that I've changed .range to .cells and changed the destination row to NextRow
        NextRow = NextRow + Rngsource.Rows.Count
    Next c
End With

Application.ScreenUpdating = True

End Sub