2. Makro beim Speichern mit abspeichern

Sub Speichern_unter_neuem_Namen_Typ02()
Dim Neuer_Dateiname As String
Dim xlOldSheetscount As Integer
Rem Speicherpfad und Dateiname anfordern
Neuer_Dateiname = Application.GetSaveAsFilename(InitialFileName:="", fileFilter:="Excel- _
Arbeitsmappe (*.xlsm), *.xlsm")
Rem Abbruch wenn Dateiname leer
If Neuer_Dateiname = "Falsch" Then Exit Sub
Rem Anzahl Standardblätter merken
xlOldSheetscount = Application.SheetsInNewWorkbook
Rem Anzahl Standardblätter temporär umstellen
Application.SheetsInNewWorkbook = 1
Rem Gewünschten Inhalt kopieren
ActiveSheet.Range("A1:AH278").Copy
Rem Neue Arbeitsmappe einfügen
Workbooks.Add
Rem Bildschirmmeldungen deaktivieren
Application.DisplayAlerts = False
Rem Inhalt einfügen und Arbeitsmappe speichern
With ActiveWorkbook
.Sheets(1).Range("A1").PasteSpecial xlPasteValues
.Sheets(1).Range("A1").PasteSpecial xlPasteFormats
.Sheets(1).Range("A1").PasteSpecial xlPasteColumnWidths
.SaveAs Filename:=Neuer_Dateiname, FileFormat:=xlOpenXMLWorkbookMacroEnabled
.Close
End With
Rem Bildschirmmeldungen aktivieren
Application.DisplayAlerts = True
Rem Anzahl Standardblätter wiederherstellen
Application.SheetsInNewWorkbook = xlOldSheetscount
End Sub

Sub Drucken()
'Erstellt 29.06.2015 André Fungipani
'makro zum Drucken inkl. Druckbereichsanpassung
Dim Zeile As Long, wks As Worksheet
Set wks = ActiveSheet
With wks
Zeile = .Cells(.Rows.Count, 1).End(xlUp).Row 'Letzte Zeile mit Daten in Spalte A
'Letzte Zeile mit nummerischem Wert finden
Do Until IsNumeric(.Cells(Zeile, 1).Text) Or Zeile = 10
Zeile = Zeile - 1
Loop
.PageSetup.PrintArea = .Range(.Cells(1, 1), .Cells(Zeile, 20)).Address(ReferenceStyle:=xlA1) _
.PrintOut Preview:=True
End With
' Gehört zu 

Sub drucken
' End Sub



Leider weiß ich nicht, wie ich dem ersten Makro das beibringen soll. 

Zusätzlioch möchte ich dass beim Speichern ein Button  erzeugt wird, dem ich

dann das zweite Makro zuweisen kann.

Vielen Dank für eure Hilfe.

Grus

André