Reiter aus Excel exportieren VBA

[itaflo]

Hallo,

ich möchte einen einzelnen Reiter aus meiner Excel Liste exportieren was aber leider nicht ganz funktioniert

mein VBA:

Code [Auswählen] Erweitern

Sub Speichern()
  Dim i As Integer
  Dim sPath As String, sFile As String
  Application.ScreenUpdating = False
    For i = 1 To Worksheets.Count
      sPath = "Q:\Daten\PTLP_Datenmanagement\01 Auswertungen\03 LL und Cogi\Test123.xlsm"
        Sheets(i).Activate
      sFile = ActiveSheet.Name
      ActiveSheet.Copy
      Application.DisplayAlerts = False
      ActiveWorkbook.SaveAs sFile
      ActiveWorkbook.Close savechanges:=False
      MsgBox "Das Blatt wurde unter " _
        & sPath & sFile & " gespeichert!"
    Next
  Application.ScreenUpdating = True
End Sub

Nur leider funktioniert das nicht so wie ich das möchte.

1. bekomme ich die Datei nicht Als Test123.xlsm Datei abgespeichert
2. Die Datei wird immer bei Dokumente gespeichert.
Als Nachricht bekomme ich immer "Dateipfad: Q:\Daten\PTLP_Datenmanagement\01 Auswertungen\03 LL und Cogi\Test123.xlsmTabelle1"