Tabelle2.Visible vergessen....

Option Private Module
 
Sub Absenden()
  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
  Dim MsgTxt As String
 
'Vollständigkeitsprüfung
  If Tabelle1.Range("E20").Value = "" Then
     MsgTxt = "Zelle Baubeginn ist leer. Tragen Sie den Baubeginn ein!"
  ElseIf Tabelle1.Range("E22").Value = "" Then
     MsgTxt = "Zelle Bauende ist leer. Tragen Sie das voraussichtliche Bau-Ende ein!"
  ElseIf Tabelle1.Range("E24").Value = "" Then
     MsgTxt = "Zelle Budgetierte Bausumme (EUR) ist leer. Tragen Sie einen Wert ein!"
  ElseIf Tabelle1.Range("E26").Value = "" Then
     MsgTxt = "Zelle Tochtergesellschaft ist leer. Tragen Sie einen Wert ein!"
  End If
  If MsgTxt <> "" Then
     MsgBox MsgTxt, vbCritical, "Prüfung"
     ActiveSheet.Protect Password:=""
     Tabelle2.Visible = False
     Exit Sub
  End If

  ActiveSheet.Unprotect Password:=""
  Tabelle2.Visible = True
  
  On Error Resume Next
  Set Source = Range("A1:I27").SpecialCells(xlCellTypeVisible)
  On Error GoTo 0
  If Err = 0 Then
    
     [G4] = [G4] + 1
 
     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 = "irgendeinmail@weisnicht.de"
             .CC = ""
             .BCC = ""
             .Subject = "Projekt"
             .Body = "Bauprojekt" & 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
 
     With Application
         .ScreenUpdating = True
         .EnableEvents = True
     End With
 
  End If
 
  ActiveSheet.Protect Password:=""
End Sub