Code is modified by OP from Claus' original.

Why must I add 1 to the Inputbox entries to return the proper "Week"?

Without the + 1, entries of 2 and 4 return Week1 to Week3.

https://www.dropbox.com/s/lnjqgmpnlc...ader.xlsm?dl=0

Howard

Sub Week_Reader_A_revised()
'/ by Claus @ MS Public (Modified by OP)

Dim fWeek As Long, lWeek As Long, lRow As Long, i As Long
Dim myArr As Variant
Dim f As Range, l As Range, myRng As Range, wkRng As Range

fWeek = Application.InputBox("Enter the STARTING WEEK to search for", "Start Weeknumber", Type:=1) + 1
If fWeek = False Then Exit Sub

lWeek = Application.InputBox("Enter the ENDING WEEK to search for", "Last Weeknumber", Type:=1) + 1
If lWeek = False Then Exit Sub

Sheets("Master").UsedRange.ClearContents

myArr = Array("Bodypump", "Bodystep-step", "Y-Blitz", "Y-Chisel", "Y-Cycle", "Zumba")

Application.ScreenUpdating = False

For i = 0 To UBound(myArr)
Set myRng = Nothing
With Sheets(myArr(i))

Set f = .Range("A2:A100").Find(fWeek, LookIn:=xlValues, lookat:=xlPart)
Set l = .Range("A2:A100").Find(lWeek, LookIn:=xlValues, lookat:=xlPart)
If Not f Is Nothing Then
lRow = Sheets("Master").Cells(Rows.Count, 1).End(xlUp).Row

If lRow = 1 Then
Set wkRng = .Range(fWeek & ":" & lWeek)
Set myRng = Union(.Rows(1), wkRng)
myRng.Copy Sheets("Master").Range("A1")

Else

Set wkRng = .Range(fWeek & ":" & lWeek)
Set myRng = Union(.Rows(1), wkRng)
myRng.Copy Sheets("Master").Cells(lRow + 2, 1)

End If
End If
End With
Next

Sheets("Master").Columns("A:Z").AutoFit
Sheets("Master").Rows("1:200").AutoFit
Application.ScreenUpdating = True
End Sub