Array an anderes Workbook übergeben

Sub SpritzFolgeAuslesen()
Set PSMListe = GetObject(ThisWorkbook.Path & "\" & "PSM Liste.xlsm")
Set wbSpritzfolge = ThisWorkbook
Windows("Spritzfolge.xlsm").Visible = True
Set PSMListe = PSMListe.Sheets("PsmListe")
Set wbSchlageinteilung = GetObject(ThisWorkbook.Path & "\" & "Schlageinteilung.xlsm")
'letzte Zeile und letzte Spalte von Listen ermitteln
lzPSMliste = PSMListe.Range("A65536").End(xlUp).Row
lsPSMliste = PSMListe.Range("A5").End(xlToRight).Column
lzSpritzfolge = wbSpritzfolge.ActiveSheet.Range("B65536").End(xlUp).Row
lzSchläge = wbSchlageinteilung.Sheets(ThisWorkbook.ActiveSheet.Name).Range("B65536").End( _
xlUp).Row
Dim Schläge As Range
Dim Schlag As Range
Dim Spritzfolge As Range
Dim Spritzung As Range
Dim gefunden As Integer
Dim Treffer As Range
Dim ErsterTreffer As Range
Dim Meldung As String
Dim x As Integer
Dim m As Integer
'Sammlung(x,0,0) = Schlag
'Sammlung(0, x, 0) = Mittel
'Sammlung(0, x, 1) = MaxAnzahlAnwendungen
'Sammlung(x,x,2) = Anzahl Anwendungen
Set Schläge = wbSchlageinteilung.Sheets(ThisWorkbook.ActiveSheet.Name).Range("B5:B" & lzSchläge) _
_
Set Spritzfolge = wbSpritzfolge.Sheets(ThisWorkbook.ActiveSheet.Name).Range("B3:B" &  _
lzSpritzfolge)
ReDim Preserve sammlung(5 To lzSchläge, lzPSMliste, 3)
'Jeden Schlag in der Schlageinteilung einmal durchgehen
For Each Schlag In Schläge
m = 1
'Schlag in Array einlesen  inkl. angewendetem Mittel und MaxAnwendungen
With PSMListe
For x = 5 To lzPSMliste
If WorksheetFunction.CountIf(.Range("A5:A" & x), .Cells(x, 1)) = 1 Then
'Schlagnamen auf Position 0,0 schreiben
sammlung(Schlag.Row, 0, 0) = Schlag.Value
'Schreibe auf jeden Schlag jedes Mittel auf jeden Schlag auf Position 0
sammlung(Schlag.Row, m, 0) = .Cells(x, 1)
'Schreibe auf die passende Position 1 die MaxAnzahlAnwendungen
sammlung(Schlag.Row, m, 1) = .Cells(x, 5)
m = m + 1
End If
Next
End With
'm ist nach dem Einlesen die Anzahl der Mittel in der PSMListe (ohne Doppeleinträge)
'Leerzeilen im Schlag möglich deswegen --> Wenn der Schlag leer ist überspringen
If Not Schlag Is Nothing Then
'Schlag in der Spritzfolge suchen und die Range in die Variable Treffer schreiben
Set Treffer = Spritzfolge.Find(what:=Schlag.Value)
'Nötig um das Ende der Schleife zu finden
Set ErsterTreffer = Treffer
If Not Treffer Is Nothing Then
Do
'Suche das Mittel im Array
For x = 0 To m
If Treffer.Offset(0, 3).Value = sammlung(Schlag.Row, x, 0) Then Exit  _
For
Debug.Print Treffer.Offset(0, 3)
Debug.Print sammlung(Schlag.Row, x, 0)
Next x
'Position des Arrays darf nicht leer sein da sonst kein Wert dazuaddiert  _
werden kann
If sammlung(Schlag.Row, m, 2) = " " Then sammlung(Schlag.Row, m, 2) = 0
'Addiere auf die Schlag/Mittelkombination auf Platz 2 eine Anwendung (Platz  _
_
1 = MaxAnzahlanwendungen)
sammlung(Schlag.Row, m, 2) = sammlung(Schlag.Row, m, 2) + 1
Set Treffer = Spritzfolge.FindNext(Treffer)
Loop Until Treffer Is Nothing Or Treffer = ErsterTreffer
End If
End If
Next Schlag
End Sub