Option Explicit Sub test() Dim v Dim w(), m(1 To 5) Dim i As Long, j As Long Dim n As Long v = Sheets("sheet1").Cells(1).CurrentRegion.Resize(, 12).Value ReDim w(1 To UBound(v), 1 To 12) For i = 1 To 5 For j = 1 To 12 w(i, j) = v(i, j) Next Next n = i For i = 6 To UBound(v) If v(i, 1) = "Hello" Then For j = 1 To 5 m(j) = v(i + 1, j) Next i = i + 3 Do For j = 1 To 7 w(n, j) = v(i, j) Next For j = 8 To 12 w(n, j) = m(j - 7) Next n = n + 1 If i = UBound(v) Then Exit Do If v(i + 1, 1) = "Hello" Then Exit Do i = i + 1 Loop End If Next With Sheets("sheet2").Cells(1).CurrentRegion .ClearContents .Resize(n - 1, 12).Value = w End With End Sub