Ich habe unterdessen kleine Anpassungen vorgenommen. Habe jedoch nicht erwartet, dass diese zu einer Verbesserung der Lage führen. Das Skript läuft jetzt wie gewollt. 

Zu den Anpassungen gehören: 

Zeile 77: hier habe ich die FindNext Funktion ThisPos zugewiesen und nicht einer neuen Variablen (zuvor  war es 'ThisPos2')

Zeile 78: habe von 'ThisRow2 = ThisPos2.Row' zu 'ThisRows = ThisPos.Row' 

Zeile 79: If Bedingung entsprechend angepasst

Zeile 82: gelöscht (ThisPos = ThisPos2)

Zeile 85: If Bedingung von 'IsEmpty(Zeile) = True' zu '(IsEmpty(Zeile)) Or (Zeile = 0)' verändert.

Hier ist der 'alte' Code.

Set ThisPos2 = WSh.Range("D:D").FindNext(ThisPos)                                    'Zeile 77                   'Die Position des nächsten Models eruieren.
                ThisRow2 = ThisPos2.Row
                If (ThisRow2 <= ThisRow) Then                                                                              'Da die While-Schleife immer wieder oben in der Liste beginnt, sobald sie den letzten Eintrag geprüft hat, muss geprüft werden, ob die neu gefundene Zeilennummer grösser ist als die bestehende um sie weiter zu verwenden. Ansonsten muss die Schleife verlassen werden.
                    Exit Do
                Else
                    ThisPos = ThisPos2
                End If
                Loop While Not ThisPos Is Nothing
                If IsEmpty(Zeile) = True Then

Hier ist der 'neue' Code:

Set ThisPos = WSh.Range("D:D").FindNext(ThisPos)                                        'Zeile 77               'Die Position des nächsten Models eruieren.
                ThisRows = ThisPos.Row
                If ThisRows <= ThisRow Then                                                                              'Da die While-Schleife immer wieder oben in der Liste beginnt, sobald sie den letzten Eintrag geprüft hat, muss geprüft werden, ob die neu gefundene Zeilennummer grösser ist als die bestehende um sie weiter zu verwenden. Ansonsten muss die Schleife verlassen werden.
                    Exit Do
                Else
                    
                End If
                Loop While Not ThisPos Is Nothing
                'MsgBox ("Zeile enthält: " & Zeile)
                If (IsEmpty(Zeile)) Or (Zeile = 0) Then

Kann es sein, dass wenn einer Variablen kein Wert zugewiesen wird, diese dann nicht leer ist sondern den "Wert" 0 enthält?

Auf jeden Fall Bedanke ich mich recht herzlich bei dir für deine Hilfe.