Store specific rows in an array

[YasserKhalil]

Hello everyone
In my attachment I have attached the expected results as I can't describe completely the issue
But simply I need to store specific sets the are found after specific value
I am searching for example for number 1, and if the number 1 found , the next set (row) will be stored in temp array ...
And if the number 1 found in two sets (rows) .. in that case to store these two sets and the following set(row) >> I mean to store all the three sets in that case

Thanks advanced for help

[YasserKhalil]

I have this solution


Sub Test()
'========================================================
'1 >> The Number To Search
'Sheets("Sheet1") >> The Source Sheet For Data
'5 >> The First Row In Source Sheet
'3 >> The First Column In Source Sheet
'Sheets("Sheet2") >> The Target Sheet For Results
'8 >> The First Row In Target Sheet
'4 >> The First Column In Target Sheet
'========================================================
CopyRows 1, Sheets("Sheet1"), 5, 3, Sheets("Sheet2"), 8, 4
End Sub


Sub CopyRows(theNum As Long, sourceSheet As Worksheet, sourceRow As Long, sourceCol As Long, targetSheet As Worksheet, targetRow As Long, targetCol As Long)
Const numCols As Long = 5 'Columns Count
Dim lastRow As Long
Dim col As New Collection
Dim itm As Variant


Application.ScreenUpdating = False
With targetSheet
.Range(.Cells(targetRow, targetCol), .Cells(Rows.Count, targetCol)).Resize(ColumnSize:=numCols).ClearContents
End With
lastRow = sourceSheet.Cells(Rows.Count, sourceCol).End(xlUp).Row

On Error Resume Next
For sourceRow = sourceRow To lastRow
If Not sourceSheet.Cells(sourceRow, sourceCol).Resize(ColumnSize:=numCols).Find(What:=theNum, LookAt:=xlWhole) Is Nothing Then
If Not sourceSheet.Cells(sourceRow + 1, sourceCol).Resize(ColumnSize:=numCols).Find(What:=theNum, LookAt:=xlWhole) Is Nothing Then
col.Add Key:=CStr(sourceRow), Item:=sourceRow
col.Add Key:=CStr(sourceRow + 1), Item:=sourceRow + 1
col.Add Key:=CStr(sourceRow + 2), Item:=sourceRow + 2
ElseIf sourceRow = lastRow Then
col.Add Key:=CStr(sourceRow), Item:=sourceRow
Else
col.Add Key:=CStr(sourceRow + 1), Item:=sourceRow + 1
End If
End If
Next sourceRow
On Error GoTo 0

For Each itm In col
targetSheet.Cells(targetRow, targetCol).Resize(ColumnSize:=numCols).Value = sourceSheet.Cells(itm, sourceCol).Resize(ColumnSize:=numCols).Value
targetRow = targetRow + 1
Next itm

Application.Goto targetSheet.Range("A1"), True
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub


But I need this task to be done using arrays as I have large amounts of data