Sub AktiveTabelleAlsEMailVersenden()
Dim Empfänger As String
Empfänger = InputBox("Geben Sie den Empfänger des e-Mails ein!")
If Empfänger = "" Then Exit Sub
ActiveWorkbook.ActiveSheet.Copy
ActiveWorkbook.SaveAs Range("A1").Value & ".xls"
ActiveWorkbook.SendMail Recipients:=Empfänger, _
Subject:=Range("A1").Value
ActiveWorkbook.Close savechanges:=False
End Sub