Attribute VB_Name = "Modul2"
Option Explicit
'
'
' Umspeichern eines Tabellenblattes in eine neue EXCEL-Arbeitsmappe
' Aufruf Parameter :
'              blatt : Tabellenblattname 
'              name  : Dateiname der neuen Arbeitsmappe ohne Dateiattribut
'              pfad  : Verzeichnis, wo die neue Arbeitsmappe abgelegt wird  
' Aufruf Beispiel : Call TabAuslagern("Tabelle1","Datei","C:\EXCEL\")
'
Sub TabAuslagern(blatt As String, name As String, pfad As String)
'
Dim name_alt As String
Dim name_neu As String
Dim sht
'
name_alt = ThisWorkbook.name
Workbooks.Add
name_neu = ActiveWorkbook.name
Windows(name_alt).Activate
'
Sheets(blatt).Activate
ActiveSheet.Select
ActiveSheet.Copy after:=Workbooks(name_neu).Sheets(1)
' alle anderen Arbeitsblätter entfernen
Windows(name_neu).Activate
Application.DisplayAlerts = False
For Each sht In ActiveWorkbook.Sheets
        If UCase(sht.name) <> UCase(blatt) Then
             sht.Delete
        End If
Next sht
'speichern
Sheets(blatt).Activate
ActiveWorkbook.SaveAs Filename:=pfad & name, _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
Application.DisplayAlerts = True
ActiveWorkbook.Close
'
End Sub
'--------------------------------------------------------------------------------