Need help with loop

[FurRelKT]

Hello, i hope that someone can help me, here is my code, i am not
understanding where i need to put the loop inorder to preserve what i
have in my .Find and then copy it over to the other sheet.
I was thinking about using an array for the [arrSection and
arrDestSection], i hope that i am on the right track. How do i save
that data from the the .Find and then at the end, enter it into the
formatted sheet, using each part of the arrDestSection? Hope that i
have explained it properly.
My sheets are set up like:
sSheet /// A2:F8 would have the F column value being 'Secondary', then
A9:F20 could have the F column as Primary and the last A21:F30 could be
'Non-Production. I copy what is in the rows, minus the F column.

a - through - f column
A2 f column Secondary
....
A8 f column Secondary
....
A9 f column Primary
A20 f column Primary
....
A21 f column Non-Production
....
A30 f column Non-Production

dSheet /// set up as a template with specific formatting and formulas.
A8 is always the first empty row, but i have code to find that 1st
empty row and if there is not enough room it adds rows, preserving the
format, lets say it goes to A45 with a value of "Total Primary Tasks".
The second section of the sheet could be A50, with a value of "Total
Secondary Tasks", starts from there, and i want it to do the same as
above, finding the first empty row available after the cell that
contains the value "Secondary Tasks".
and the same with the third section of the sheet which would contain
the "Non-Production Tasks" and the "Total Non-Production Tasks" rows.

A8- always the first available row for "Primary Tasks"
....
A15 Contains the value "Total Primary Tasks"

A18 contains the value "Secondary Tasks"
....
A21 contains the value "Total Secondary Tasks"

A23 contains the value "Non-Production Tasks"
....
A26 contains the value "Total Non-Production Tasks"

Overall, i am trying to find the section values in sSheet, and copy
them over the corresponding section in the dSheet.

Here is what i have so far, with much help from this forum, hope that
someone can give me more insight as to what to do next, i am fairly new
and need lots of help...thanks so much. ANy help would really be
appreciated.

Keri~

The code below works great for the first section "Primary"

Option Explicit

Sub SendData()

Dim FindFirst As Range
Dim FindLast As Range
Dim searchRange As Range
Dim copyRange As Range
Dim WhatToFind As String
Dim DestCell As Range
Dim FinalRow As Long
Dim sBook As Workbook
Dim sSheet As Worksheet
Dim dBook As Workbook
Dim dSheet As Worksheet
Dim theName As String
Dim FoundCell As Range
Dim strPri As String
Dim fAddr
Dim Row1 As Integer
Dim Row2 As Integer
Dim NumRows As Integer
Dim RowCntr As Integer
Dim RowsNeeded As Integer
Dim arrSection() As String
Dim i As Integer
Dim arrDestSection() As String
Dim strGroup As String
Dim x As Integer

With Application
.DisplayAlerts = False
End With

Erase arrSection
Erase arrDestSection

Set sBook = ThisWorkbook 'or ActiveWorkbook ???
Set dBook = Workbooks.Open("E:\Excel\Portlet & Global Dev together
TEST\DesBook.xls")
Set dSheet = dBook.Sheets("Template")

' ReDim arrSection(2)
' arrSection(0) = "Primary"
' arrSection(1) = "Secondary"
' arrSection(2) = "Non-Production"


For Each sSheet In sBook.Worksheets
sSheet.Activate
If Cells(1, 1).Value = vbNullString Then
Exit Sub
End If
With ActiveSheet
FinalRow = Cells(Rows.Count, 6).End(xlUp).Row

' For i = LBound(arrSection) To UBound(arrSection)
' WhatToFind = (arrSection(i))
WhatToFind = "Primary"

Set searchRange = .Range("F2:F" & FinalRow)
With searchRange
Set FindFirst = .Find(What:=WhatToFind, _
LookIn:=xlValues, LookAt:=xlWhole, _
after:=.Cells(.Cells.Count), _
SearchDirection:=xlNext)
Set FindFirst = FindFirst.Offset(0, -5)
Debug.Print FindFirst.Address
Row1 = FindFirst.Row
Set FindLast = .Find(What:=WhatToFind, _
LookIn:=xlValues, LookAt:=xlWhole, _
after:=.Cells(1),
SearchDirection:=xlPrevious)
Set FindLast = FindLast.Offset(0, -1)
Debug.Print FindLast.Address
Row2 = FindLast.Row

NumRows = Row1 - Row2
Debug.Print "The FIND row count: " & NumRows
End With
' Next i
End With
If FindFirst Is Nothing Then
MsgBox "Nothing found"
Exit Sub
End If

Set copyRange = Range(FindFirst, FindLast)
Debug.Print "the copy range: "; copyRange.Address


theName = sSheet.Name

With dBook.Worksheets

dSheet.Copy after:=.Item(.Count)
ActiveSheet.Name = theName

' ReDim arrDestSection(2)
' arrDestSection(0) = "Total Primary Tasks"
' arrDestSection(1) = "Total Secondary"
' arrDestSection(2) = "Total Non-Production Hours"

' For x = LBound(arrDestSection) To UBound(arrDestSection)
' strGroup = (arrDestSection(x))
strGroup = "Total Primary Tasks"
Set FoundCell = Cells.Find(strGroup, _
LookIn:=xlValues, LookAt:=xlWhole)
Debug.Print FoundCell.Address
' Next x
Debug.Print FoundCell.Address
If Not FoundCell Is Nothing Then
fAddr = FoundCell.Address
FoundCell.Select
If IsEmpty(ActiveCell) = False Then
'MsgBox "not empty"
ActiveCell.Offset(-2, 0).Select
If IsEmpty(ActiveCell) = False Then
Call InsertRowsAndFillFormulas_caller
End If
' //the loop for finding an empty cell to place
everything...///////////////
RowCntr = 1
Do
If IsEmpty(ActiveCell) = True Then
ActiveCell.Offset(-1, 0).Select
RowCntr = RowCntr + 1
End If
Loop Until IsEmpty(ActiveCell) = False
Debug.Print "the Empty rows in sheet: " & RowCntr
End If
Else
MsgBox "Cannot find [Correct] String"
End If
ActiveCell.Offset(1, 0).Select
RowsNeeded = Abs(NumRows) - RowCntr
RowsNeeded = RowsNeeded + 2
Debug.Print "Need: " & RowsNeeded & " Rows"
MsgBox "You need " & RowsNeeded & " more Rows added to sheet"

If Not NumRows = RowCntr Then
InsertRowsAndFillFormulas (RowsNeeded)
End If
End With

Set DestCell = ActiveCell
Debug.Print DestCell.Address

copyRange.Copy Destination:=DestCell

Next sSheet

With Application
.DisplayAlerts = True
End With

End Sub