Guten Tag zusammen. 

Ich hab mir einen kleinen VBA code zusammengeschustert um den Ablauf des Verkaufs vereinfachen soll. Jedoch erscheint beim Ausführen stets eine Fehlermeldung. 

Laufzeitfehler '1004':

Die Methode 'Range' für das Objekt '_Worksheet' ist fehlgeschlagen.

Option Explicit
 
Sub Verkaufen()
'
' Bestellen Makro
'
 Dim Marke As String
 Dim Standort As String
 Dim WSh As Worksheet
 Dim WKb As Workbook
 Dim ThisPos As Range
 Dim Anzahl As Long
 Dim Model As String
 Dim ThisRow As Long
 Dim Monat As String
 Dim Einheit As Long
 Dim Farbe As String
  
  
  
 With ThisWorkbook.Sheets("Verkaufsformular")
 
'?berpr?fen ob Zellen ausgef?llt sind
    If IsEmpty(.Range("C5")) Then
        MsgBox ("Bitte Anzahl einf?gen!")
        Exit Sub
    ElseIf IsEmpty(.Range("D5")) Then
        MsgBox ("Bitte Einheit einf?gen!")
        Exit Sub
    ElseIf IsEmpty(.Range("E5")) Then
        MsgBox ("Bitte Marke einf?gen!")
        Exit Sub
    ElseIf IsEmpty(.Range("F5")) Then
        MsgBox ("Bitte Model einf?gen!")
        Exit Sub
    ElseIf IsEmpty(.Range("G5")) Then
        MsgBox ("Bitte Farbe einf?gen!")
        Exit Sub
    ElseIf IsEmpty(.Range("H5")) Then
        MsgBox ("Bitte Standort einf?gen!")
        Exit Sub
    End If
  
   Marke = .Range("E5").Value
   Standort = .Range("H5").Value
   Model = .Range("F5").Value
   Einheit = .Range("D5").Value
   Farbe = .Range("G5").Value
  
'In passendes File einf?gen

    If InStr("Aarau,Baden,Haselstrasse,Luzern,Reinach", Standort) > 0 Then
    

'In passendes Tab einf?gen
  
        If InStr("Finn Comfort,FootJoy,Meindl,New Balance,Steitz,K?nzli,Lloyd,Anova Xelero,Stucco,Uvex,Bort (Orthosan),Bauerfeind,Sascha Herzog,Lyreco,Perpedes,Ottobock,Orthoservice,Sigvaris,Smedico,Zbinden,Rudolf Roth,Juzo,Berro,Jobst,Oped,?ssur,Swissmed,Divers", Marke) > 0 Then
   
'Zieldatei ?ffnen
            Set WKb = Workbooks.Open("I:\Domenic Stamm\Verkaufslisten\Verkaufsliste " & Standort & ".xlsm")
            Set WSh = WKb.Worksheets(Marke)
            
            Set ThisPos = WSh.Range("C:C").Find(What:=Model, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)

            If Not ThisPos Is Nothing Then                      'ist bereits eine Ausgabe diese Models in der Liste?
                ThisRow = ThisPos.Row
                Monat = WSh.Range("G" & ThisRow).Value
            ElseIf Monat = MonthName(Month(Now)) And Einheit = WSh.Range("B" & ThisRow).Value And Farbe = WSh.Range("E" & ThisRow).Value Then           '...und wurde es im selben Monat, selbe Gr?sse und Farbe verkauft?
                Anzahl = WSh.Range("A" & ThisRow).Value
                WSh.Range("A" & ThisRow).Value = Anzahl + 1
            Else
            
            WSh.Range("A2").EntireRow.Insert CopyOrigin:=xlFormatFromRightOrBelow
            WSh.Range("A2").Resize(1, 6).Value = .Range("C5:H5").Value
            WSh.Range("G2").Value = MonthName(Month(Now))
            End If
            WKb.Close SaveChanges:=True
            .Range("C5:H5").ClearContents         'Nur l?schen bei g?ltiger Marke
        End If
        
    End If
  
 End With
  
End Sub

Der Debugger markiert jeweils die Zeile welche mit 'ElseIf Monat = ...... ' beginnt. Leider habe ich nicht herausgefunden woran es liegt. In einem früheren Skript habe ich es bereits gleich gemacht und dort hat's geklappt. 

Danke für die Hilfe

Lg staeme