Hallo Volti

Dein Code funktioniert wunderbar im Script, das ich gestern gepostet habe. Nun habe ich mir den Tipp eines weiteren Hilfestellers, möglichst keine "select" zu verwenden, zu Herzen genommen und noch weitere Codes optimiert. 

Leider bekomme ich nun erneut eine Fehlermeldung bei einer Code-Zeile, welche ich von dir übernommen habe. 

Folgende Zeile bereitet Probleme: 

WSb.Range("A2").Value = .Range("A2:I" & ZeilMax).Value

hier mein gesamter Code:

Sub Finn_Comfort_bestellen()
'
'   Schaltfläche1_Klicken Makro
'
'   Bestimmen wieviele Zeilen bestellt werden müssen
    
    Dim ZeileMax As Long
    Dim Name As Variant
    Dim rngToFill As Range
    
' Letzte Zeile bestimmen
    
    With ThisWorkbook.Sheets("Finn Comfort")
        ZeileMax = .Cells(Rows.Count, 1).End(xlUp).Row
    ' ZeileMax = .UsedRange.Rows.Count 'die letzte Zeile wird ermittelt
    'End With
     
'   Mail inklusive Anhang generieren

    Dim SourceWB As Workbook
    Dim DestinWB As Workbook
    Dim SourceWS As Worksheet
    Dim WSb As Worksheet
    Dim OutlookApp As Object
    Dim OutlookMessage As Object
    Dim TempFileName As Variant
    Dim ExternalLinks As Variant
    Dim TempFilePath As String
    Dim FileExtStr As String
    Dim DefaultName As String
    Dim UserAnswer As Long
    Dim x As Long

    'Optimize Code
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        Application.DisplayAlerts = False

    'Copy only selected sheets into new workbook
        Set SourceWB = ActiveWorkbook
        'Set SourceWS = SourceWB.Worksheets("Finn Comfort")
        'SourceWS.Range("A1:I" & ZeileMax).Copy
        SourceWB.Windows(1).SelectedSheets.Copy
        Set DestinWB = ActiveWorkbook

    'Determine Temporary File Path
        TempFilePath = Environ$("temp") & "\"

    'Determine Default File Name for InputBox
        'If SourceWB.Saved Then
            'DefaultName = Left(SourceWB.Name, InStrRev(SourceWB.Name, ".") - 1)
        'Else
            'DefaultName = SourceWB.Name
            DefaultName = "Bestellung"
        'End If

    'Ask user for a file name
        TempFileName = Application.InputBox("Wie söll dä Aahang heissä?", _
            "File Name", Type:=2, Default:=DefaultName)
    
            If TempFileName = False Then GoTo ExitSub 'Handle if user cancels
  
    'Determine File Extension
        'If SourceWB.Saved = True Then
            'FileExtStr = "." & LCase(Right(SourceWB.Name, Len(SourceWB.Name) - InStrRev(SourceWB.Name, ".", , 1)))
        'Else
            FileExtStr = ".xlsx"
        'End If

    'Break External Links
        ExternalLinks = DestinWB.LinkSources(Type:=xlLinkTypeExcelLinks)

        'Loop Through each External Link in ActiveWorkbook and Break it
            On Error Resume Next
                For x = 1 To UBound(ExternalLinks)
                    DestinWB.BreakLink Name:=ExternalLinks(x), Type:=xlLinkTypeExcelLinks
                Next x
                On Error GoTo 0
      
    'Save Temporary Workbook
        DestinWB.SaveCopyAs TempFilePath & TempFileName & FileExtStr

    'Create Instance of Outlook
        On Error Resume Next
            Set OutlookApp = GetObject(class:="Outlook.Application") 'Handles if Outlook is already open
        Err.Clear
        If OutlookApp Is Nothing Then Set OutlookApp = CreateObject(class:="Outlook.Application") 'If not, open Outlook
    
        If Err.Number = 429 Then
        MsgBox "Outlook could not be found, aborting.", 16, "Outlook Not Found"
        GoTo ExitSub
        End If
        On Error GoTo 0

    'Create a new email message
        Set OutlookMessage = OutlookApp.CreateItem(0)

    'Create Outlook email with attachment
        On Error Resume Next
            With OutlookMessage
                .To = ""
                .CC = ""
                .BCC = ""
                .Subject = TempFileName
                .Body = "Im Anhang finden Sie die Liste mit unseren Bestellungen" & vbNewLine & vbNewLine & "Orthopädie" & vbNewLine & "Malgaroli & Werne"
                .Attachments.Add TempFilePath & TempFileName & FileExtStr
                .Display
            End With
        On Error GoTo 0

    'Close & Delete the temporary file
        DestinWB.Close SaveChanges:=False
        Kill TempFilePath & TempFileName & FileExtStr

    'Clear Memory
        Set OutlookMessage = Nothing
        Set OutlookApp = Nothing
  
    'Optimize Code
ExitSub:
  Application.ScreenUpdating = True
  Application.EnableEvents = True
  Application.DisplayAlerts = True
  
    
'   Oben Zeile einfügen in "bestellt" - Tab
    Set WSb = Sheets("Finn Comfort bestellt")
    'Sheets("Finn Comfort bestellt").Select
    WSb.Range("A2").EntireRow.Resize(ZeileMax).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
    'Rows("2:" & ZeileMax).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
    'WSb.Range("A2:K" & ZeileMax).Font.Bold = False
    
'   zu kopierenden Bereich kopieren in "Finn Comfort"-Tab
    'Sheets("Finn Comfort").Select
    'Range("A2:I" & ZeileMax).Select
    'Selection.Copy
    'Sheets("Finn Comfort bestellt").Select
    'Range("A2:I" & ZeileMax).Select
    'ActiveSheet.Paste
    'Sheets("Finn Comfort").Select
    WSb.Range("A2").Value = .Range("A2:I" & ZeilMax).Value
    .Range("A2:I" & ZeileMax).ClearContents
    
'   Kürzel in "bestellt"-Tab einfügen
    
    Name = InputBox("Wer bist du?", "Sali du.")
    'Sheets("Finn Comfort bestellt").Select
    Set rngToFill = WSb.Range("J2:J" & ZeileMax)
    rngToFill.Value = Name
    
    
'   Aktuelles Datum in Spalte einfügen

    Set rngToFill = WSb.Range("K2:K" & ZeileMax)
    rngToFill.Value = Date
        
      
    'gefüllte Zellen auswählen
        'Range("A2", Range("d1").End(xlDown).End(xlToRight)).Select

'   Knopf nach oben verschieben

    'With Worksheets("Finn Comfort")
     ' With .Shapes("Schaltfläche 1")
      '  .Top = .TopLeftCell.Offset(-(ZeileMax - 1), 0).Top
      'End With
    'End With
    End With
    ActiveWorkbook.Save
        
End Sub