Application.ScreenUpdating = False
With Sheets("Sheet1")
Dim head(3), datas(3)
Dim x
y = 26
Do
If .Rows(y).Height > 0 Then
For yy = 0 To 3
head(yy) = .Cells(y + yy, "B")
datas(yy) = .Cells(y + yy, "C")
Next yy
With Sheets("Sheet2")
yy = .Cells(.Rows.Count, "C").End(xlUp).Row + 1
If yy < 2 Then yy = 2
If .Cells(1, "A") = Empty Then
For x = 1 To 4
.Cells(yy, x) = head(x - 1)
Next x
yy = yy + 0
End If
For x = 1 To 4
.Cells(yy, x) = datas(x - 1)
Next x
End With
End If
y = y + 4
Loop Until .Cells(y, "B") = Empty
End With
Application.ScreenUpdating = True
Add the code in red. It looks only at therow height of the 1st row of each group of 4 to determine whether to copy that group of 4.
(ps. Sorry, I can't make the code indent properly and highlight the lines to be added)