Thema: Aufteilen der Arbeitsblätter in neue Arbeitsmappen

StandardModule: basMain

Sub Verteilen()
   Dim iCounter As Integer
   Dim sPath As String
   Application.ScreenUpdating = False
   sPath = Application.DefaultFilePath
   For iCounter = 3 To Worksheets.Count
      Worksheets(3).Copy
      ActiveWorkbook.SaveAs _
         sPath & "\Test" & iCounter - 2 & ".xls"
      ActiveWorkbook.Close savechanges:=False
      Application.DisplayAlerts = False
      Worksheets(3).Delete
      Application.DisplayAlerts = True
   Next iCounter
   MsgBox "Die Arbeitsmappen wurden im Verzeichnis " _
      & vbLf & sPath & " gespeichert!"
   Application.ScreenUpdating = True
End Sub

Beiträge aus dem Excel-Forum zu den Themen Allgemein und Interaktion