Hallo Doris,

da gibt es viele Möglichkeiten. Du könntest es (ich nehme an, dass es im aktuellen Blatt passieren soll) z.B. nach

Set OutApp = Nothing

einfügen.

Bedenke, dass die Mail mit diesem code nicht abgesendet wird. Falls der User dieses dann doch nicht manuell macht, ist die Kundennummer trotzdem hochgezählt.

Option Private Module
 
Sub Absenden()
 
  Dim Source As Range
  Dim Dest As Workbook
  Dim wb As Workbook
  Dim TempFilePath As String
  Dim TempFileName As String
  Dim FileExtStr As String
  Dim FileFormatNum As Long
  Dim OutApp As Object
  Dim OutMail As Object
 
  Set Source = Range("A1:I27").SpecialCells(xlCellTypeVisible)
  If Not Source Is Nothing Then
 
     With Application
         .ScreenUpdating = False
         .EnableEvents = False
     End With
 
     Set wb = ActiveWorkbook
     Set Dest = Workbooks.Add(xlWBATWorksheet)
     Source.Copy
     With Dest.Sheets(1)
         .Cells(1).PasteSpecial Paste:=8
         .Cells(1).PasteSpecial Paste:=xlPasteValues
         .Cells(1).PasteSpecial Paste:=xlPasteFormats
         .Cells(1).Select
         Application.CutCopyMode = False
     End With
 
     TempFilePath = Environ$("temp") & "\"
     TempFileName = "Selection of " & wb.Name & " " _
                  & Format(Now, "dd-mmm-yy h-mm-ss")
 
     If Val(Application.Version) < 12 Then
         'You use Excel 2000-2003
         FileExtStr = ".xlsx": FileFormatNum = -4143
     Else
         'You use Excel 2007-2010
         FileExtStr = ".xlsx": FileFormatNum = 51
     End If
 
     Set OutApp = CreateObject("Outlook.Application")
     Set OutMail = OutApp.CreateItem(0)
 
     With Dest
         .SaveAs TempFilePath & TempFileName & FileExtStr, _
                 FileFormat:=FileFormatNum
         On Error Resume Next
         With OutMail
             .GetInspector
             .To = "eine.email@weisnicht.de"
             .CC = ""
             .BCC = ""
             .Subject = "RE"
             .Body = "Rechnung" & vbCrLf & .Body
             .Attachments.Add Dest.FullName
   
             .Display
          
         End With
         On Error GoTo 0
         .Close SaveChanges:=False
     End With
 
     Kill TempFilePath & TempFileName & FileExtStr
 
     Set OutMail = Nothing
     Set OutApp = Nothing

'Kundennumer hochzählen
     Range("G4").Value = Range("G4").Value + 1
     
     With Application
         .ScreenUpdating = True
         .EnableEvents = True
     End With
     
  End If

End Sub

Und noch eine Anregung.

Wenn Du schon mittels On error resume next einen evtl. Fehler bei Set Source = Range("A1:I27").SpecialCells(xlCellTypeVisible) überspringst, solltest Du nach diesem evtl. Fehler nicht weiterarbeiten, denn Source ist ja dann nicht gesetzt.

Alternative könnte das mit einer If-Abfrage abgefangen werden.

viele Grüße

Karl-Heinz