(VBA) Probleem met .Resize

Sub Gather()

Dim StallIndex As Integer

For StallIndex = 2 To 4

SSR = "A1:AT40"
EmptyCell(1) = ""
EmptyCell(2) = " "
EmptyCell(3) = "  "

'Bepaal actief werkblad nummer
Dim n As Integer
n = ActiveSheet.Index

'Vind het juiste stalnummer
Dim CorrectRange As Range
Set CorrectRange = Sheets(n).Range(SSR).Find("Stal " & StallIndex & ": Leeftijd (weken)", lookat:=xlPart)

'Bepaal de rij waarin het correcte stalnummer zich bevindt
Dim CorrectRow As Range
Set CorrectRow = Range(CorrectRange.Row & ":" & CorrectRange.Row)

'Aantal kolommen waarin data aanwezig is
Dim CorrectWidth As Integer
CorrectWidth = Application.WorksheetFunction.CountIfs(CorrectRow, ">0", CorrectRow, "<101")

'Aantal rijen waarin data aanwezig is
Dim CorrectHeight As Integer
CorrectHeight = 0

For h = 1 To 100
 If IsInArray(Sheets(n).Range(CorrectRange.Address).Offset(h, 0).Value, EmptyCell) = False Then
    CorrectHeight = CorrectHeight + 1
 Else
    Exit For
 End If
Next h
  
 
Dim LocalSSR As Range
Set LocalSSR = Range(CorrectRange.Address).Resize(CorrectHeight, CorrectWidth)
  
Dim SearchItem() As String
ReDim SearchItem(1 To CorrectHeight)

For g = 1 To CorrectHeight
 SearchItem(g) = Sheets(n).Range(CorrectRange.Address).Offset(g, 0).Value
Next g

For j = 1 To CorrectHeight
 On Error Resume Next
 
 Dim StartCell1 As Range
 Set StartCell1 = Sheets(n).Range(LocalSSR).Find(SearchItem(j), lookat:=xlPart)

 Dim SourceCell1 As Range

 If StartCell1 Is Nothing Then
    MsgBox ("Een item van " & SearchItem(j) & " kon niet gevonden worden. Proces wordt afgebroken.")
 End If

 For i = 1 To CorrectWidth
    Set SourceCell1 = Sheets(CStr(StartCell1.Offset(-j, i))).Range(LocalSSR).Find(SearchItem(j), lookat:=xlPart)
    If SourceCell1 Is Nothing Then
        MsgBox ("Kon " & SearchItem(j) & " niet vinden op werkblad " & Sheets(CStr(StartCell1.Offset(-j, i))).Name & ". Proces wordt afgebroken.")
        Exit For
    End If
    
    Sheets(n).Range(StartCell1.Address).Offset(0, i).Value = Sheets(CStr(StartCell1.Offset(-j, i))).Range(SourceCell1.Address).Offset(0, StallIndex - 1).Value
 Next i
Next j

Next StallIndex

End Sub