VBA Loop to copy/paste blocks of columns into another worksheet with dynamic range

Hi everyone,

I usually find my answer here but I've been stuck on this one for several days now.

I'm working on 2 sheets, one with new data, and one with historical data.

On each sheet I have 'blocks' of columns, those blocks are always 4 columns wide, with a blank column in-between. And have different row length.

For example, there are data on column A to D, then a blank column, then data in column F to I, etc. as below:

Goal: Need to check if the item number (ex: Cell A1 for the first block) is equal to the item number on the destination sheet (same cell A1).

Need to copy data from row 3 (first row with actual data) until the last row, for the first block of column, onto the 2nd sheet after the last row containing data. And create a loop for each block of columns until the last column of the source sheet.

Issue: The blocks of columns have different row length. Same thing on the destination sheet, each block have different row length. Which is why I need to use a dynamic range, for each block.

My code is here below, I managed to have it working for the first block of column by using the column letters, and try to modify it to use a dynamic range, but it's deleting all the data from row 3 on the destination sheet, and copying '#N/A' from "E3" until the very last column of the excel sheet (it does take into account the number of rows of the first block of column on the source sheet).

Sub copydata()
Dim shta As Worksheet
Dim sht1 As Worksheet
Set shta = Sheets("source")
Set sht1 = Sheets("target")
Dim c As Long
Dim LastCol As Long 'last column sheet source
lrws As Long 'last row of source column
frwt As Long 'first available row in target column
Dim rngs As Range
Dim rngt As Range
Const frsrc As Long = 3 'first row on source column to copy from

For c = 1 To c + 3
    If shta.Cells(1, c).Value = sht1.Cells(1, c).Value Then 'ensure data item are the same
    lrws = shta.Cells(Rows.Count, c).End(xlUp).Row
    frwt = sht1.Cells(Rows.Count, c).End(xlUp).Row + 1
    LastCol = shta.Cells(frsrc, Columns.Count).End(xlToLeft).Column
    Set rngs = shta.Range(c & frsrc).Resize(lrws, 4) 'source range of first block of columns
    Set rngtg = sht1.Range(c & frwt & ":" & c & frwt).Resize(rngs.Rows.Count) 'target range for first block of column
    rntg.Value = rngs.Value
    c = c + 4 'move to the next block of column
    Else: MsgBox "Need to check table formatting"
    End If
Next c
End Sub

There might be a better/easier way of doing it, than moving a block of columns at a time, but that's the only way I could think about.
I'm fairly new to VBA, and would really appreciate any comments/feedback you may have.
Thank you very much in advance!

Quote from royUK

You need to attach an example workbook.

Hi royUK as requested, you'll find attached an example workbook. I only kept a certain amount of row/columns for clarity.Example.xlsm
I hope that helps. Thank you very much

Hi dangelor ! Sorry for my late reply, I wasn't able to test the code until now. Thank you so much for your feedback, it does exactly what I needed to . Do you reckon there would be a way to optimized the code without activate and select? Because when I run the macro on my full data set, it's a bit slow. I've tried using With sheet 1 instead of Sheet 1.Activate, but it doesn't seem to be working..

Hi dangelor actually I've just noticed something. I have to do the same operations on 2 sheets (both with 2 different source sheets). It works perfectly on one of them, that has the exact same format as the example I've shared.

But on the other sheet, I noticed there are, for some columns, data on the first row for example C1, L1. So the copy/paste doesn't work properly. It paste the first block correctly, then paste the same data again below the data that has just been pasted 2 columns on the right, etc. and I'm not sure how to fix that issue.
I attached an updated workbook example.Example.xlsm

I worked on the code and changed it as below, it seems to be working on my data. Let me know what you think

I actually didn't know about the CurrentRegion and wasn't sure how to use Offset, so thank you so much for that

Sub copydata()

Dim wb As Workbook
Set wb = ThisWorkbook
Dim shta As Worksheet, sht1 As Worksheet
Set shta = wb.Sheets("source")
Set sht1 = wb.Sheets("target")
Dim lastcola As Long
Dim i As Integer

With shta
lastcola = shta.Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To lastcola Step 5
    If shta.Cells(1, i).Value = sht1.Cells(1, i).Value Then
    shta.Cells(1, i).CurrentRegion.Offset(2).Copy sht1.Cells(Rows.Count, i).End(xlUp).Offset(1)
    Else: MsgBox "Need to check table formatting"
    End If
Next i
End With