This line will not copy the header of the Sheets(MyArr(i)) in the code below.

Range(Cells(1, 1), Cells(1, lcSH)).Copy Sheets("Master").Range("A" & Rows.Count).End(xlUp)(1) - or with the (2)

In a snippet run in the sheet module the line works fine.

Note that if it is the first time the code runs, I want the header to copy to row 1 on Master sheet and the FoundWk entries to copy directly below that header.

I believe I have the code set to provide a blank row for each time the code is run so there will be a header copy and a number of entries directly following. Then when run again, a blank row then a header copy and a number of entries directly following. (Can't get the header to copy so that has not been verified)

So on the Master I would have starting in row 1:

Header
entry
entry
entry

Header
entry
entry
entry
entry
entry

Header
entry
entry

Thanks,
Howard

Sub WeeklyReader()
Dim c As Range
Dim i As Long
Dim MyArr As Variant
Dim lrSH As Long, lcSH As Long
Dim FoundWk As Range
Dim aWeek As Variant

aWeek = InputBox("Enter the WEEK to search for")

If aWeek = "" Then
Exit Sub
ElseIf IsNumeric(aWeek) Then
aWeek = Val(aWeek) '/ converts a "text" number to a value
Else
'/ is text and that is okay
End If

MyArr = Array("Bodypump", "Spinning", "Zumba")

Application.ScreenUpdating = False

For i = LBound(MyArr) To UBound(MyArr)

With Sheets(MyArr(i))

lrSH = .Cells(Rows.Count, 1).End(xlUp).Row
lcSH = .Cells.Find(What:="*", after:=[A1], _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column

Set FoundWk = .Range("A2:A" & lrSH).Find(What:=aWeek, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)

If Not FoundWk Is Nothing Then
If Sheets("Master").Range("A" & Rows.Count).End(xlUp).Row = 1 Then
Range(Cells(1, 1), Cells(1, lcSH)).Copy Sheets("Master").Range("A" & Rows.Count).End(xlUp)(1)
FoundWk.Resize(1, lcSH).Copy Sheets("Master").Range("A" & Rows.Count).End(xlUp)(2)
Else
Range(Cells(1, 1), Cells(1, lcSH)).Copy Sheets("Master").Range("A" & Rows.Count).End(xlUp)(3)
FoundWk.Resize(1, lcSH).Copy Sheets("Master").Range("A" & Rows.Count).End(xlUp)(2)
End If
End If

End With
Next 'i

Application.ScreenUpdating = True
End Sub