Sub Main()
Dim r As Range, t As Range, a As Range
Set t = Worksheets("Sheet1").[A1]
With Worksheets("WEEKPLANNING")
Set r = .Range("AF24", .Cells(Rows.Count, "AF").End(xlUp))
End With
r.AutoFilter 1, "=True"
Set a = StripFirstRow(r).Columns(2).SpecialCells(xlCellTypeVisible)
r.AutoFilter
If a Is Nothing Then Exit Sub
a.Copy t
Application.CutCopyMode = False
End Sub
Function StripFirstRow(aRange As Range) As Range
Dim i As Long, j As Long, r As Range, z As Long, idx As Long
For i = 1 To aRange.Areas.Count
For j = 1 To aRange.Areas(i).Rows.Count
z = z + 1
If z = 1 Then GoTo NextJ
If r Is Nothing Then
Set r = aRange.Areas(i).Rows(j)
Else
Set r = Union(r, aRange.Areas(i).Rows(j))
End If
NextJ:
Next j
Next i
Set StripFirstRow = r
End Function