This seems to work based on the sample data you provided.
Code:
Sub simi_test()
Dim lTotalColumns As Long
Dim lCurrentColumn As Long
Dim lCurrentRow As Long
Dim iRowOffset As Integer
Dim iRowDest As Integer
Application.ScreenUpdating = False
lCurrentColumn = 1
lCurrentRow = 1
iRowOffset = 1 'change this value to however many rows under the header row you want to copy.
iRowDest = 2 'change this value to 1+ how many rows you want between the data in this example 2 will put 1 blank row between data
With ActiveSheet
lTotalColumns = .Cells(1, .Columns.Count).End(xlToLeft).Column
Do While lCurrentColumn <= lTotalColumns
If InStr(1, .Cells(lCurrentRow, lCurrentColumn), "Not on AOI") > 0 Then
.Range(.Cells(lCurrentRow, lCurrentColumn), .Cells(lCurrentRow + iRowOffset, lTotalColumns)).Copy
.Range(.Cells(lCurrentRow + iRowOffset + iRowDest, lCurrentColumn), .Cells(lCurrentRow + iRowOffset + iRowOffset + iRowDest, lTotalColumns)).PasteSpecial Paste:=xlPasteAll
.Range(.Cells(lCurrentRow, lCurrentColumn), .Cells(lCurrentRow + iRowOffset, lTotalColumns)).Clear
lCurrentRow = lCurrentRow + iRowOffset + iRowDest
End If
lCurrentColumn = lCurrentColumn + 1
Loop
.Range("A1").Select
End With
Application.ScreenUpdating = True
End Sub
I added notes in the code for the places for you to change how many rows you want to copy and how many rows between the data you want.
Bookmarks