Attribute VB_Name = "Modul1"
Sub sheets_copy(mappe_neu As String)
Attribute kopieren.VB_Description = "Autor: Lippold Rolf Stand 09.01.2002"
'
' Kopiert alle Arbeitsblätter in eine neue Arbeitsmappe (mappe_neu) 
' ohne VBA Code
' und formatiert das Druckbild aller Arbeitsblätter
' ------------------------------------------
' Aufruf des Programms 
'      Call sheets_copy("G:\Kennzahlen\INSTAB.XLS")  '
'
' -----------------------------------------
'
Dim name As String
Dim name_alt As String
Dim name_neu As String
'
name_alt = ThisWorkbook.name
'Kopieren
Workbooks.Add
name_neu = ActiveWorkbook.name
Windows(name_alt).Activate
For Each sht In ThisWorkbook.Sheets
    sht.Select
    sht.Copy after:=Workbooks(name_neu).Sheets(1)
    Windows(name_alt).Activate
Next sht
Windows(name_neu).Activate
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs FileName:=mappe_neu, FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
'Druckgestaltung
For Each sht In ActiveWorkbook.Sheets
    name = ActiveWorkbook.FullName
    sht.PageSetup.LeftHeader = ""
    sht.PageSetup.CenterHeader = "&A"
    sht.PageSetup.RightHeader = "&12Firma"
    sht.PageSetup.LeftFooter = "&8R.Lippold / &D"
    sht.PageSetup.CenterFooter = "&8 " & name
    sht.PageSetup.RightFooter = "&8Seite: &P"
Next sht
'Sichern
ActiveWorkbook.Save
ActiveWorkbook.Close Savechanges:=True
'Zurück
Windows(name_alt).Activate
End Sub