Try this for results on sheet "Summary"
Sub MG26Feb47
Dim Rng As Range, Dn As Range, c As Long
Dim Lst As Long
Application.ScreenUpdating = False
With Sheets("CQM-NAT")
Set Rng = .Range("B2", .Range("B" & Rows.Count).End(xlUp))
Lst = .Cells("1", Columns.Count).End(xlToLeft).Column
End With
c = 1
Range("A1").Resize(, Lst).Copy Sheets("Summary").Range("A1")
For Each Dn In Rng.SpecialCells(xlCellTypeConstants).Areas
With Sheets("Summary")
c = c + 1
Dn(Dn.Count + 1).Offset(, -1).Resize(, Lst).Copy .Cells(c, 1)
Dn(1).Offset(, -1).Copy .Cells(c, 1)
End With
Next Dn
Application.ScreenUpdating = True
End Sub
Regards Mick