Microsoft Excel

Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Thema

Aufteilen einer Tabelle auf mehrere Arbeitsblätter

Gruppe

Kopieren

Problem

Die Daten aus obiger Tabelle sollen gemäß den Nummern in Spalte A auf neue Arbeitsblätter verteilt werden.

Lösung
Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.

StandardModule: basMain

Sub EgaleSpeichern()
   Dim rng As Range, rngCur As Range
   Dim lngRow As Long
   Application.ScreenUpdating = False
   Set rngCur = Range("A1").CurrentRegion
   rngCur.Sort _
      key1:=Range("A2"), _
      order1:=xlAscending, _
      header:=xlYes
   lngRow = 2
   Do Until IsEmpty(rngCur.Cells(lngRow, 1))
      If rngCur.Cells(lngRow, 1) <> rngCur.Cells(lngRow - 1, 1) Then
         rngCur.AutoFilter _
            field:=1, _
            Criteria1:=rngCur.Cells(lngRow, 1)
         Set rng = rngCur.SpecialCells(xlCellTypeVisible)
         Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
         ActiveSheet.Name = rngCur.Cells(lngRow, 1)
         rng.Copy Range("A1")
      End If
      lngRow = lngRow + 1
   Loop
   Worksheets(1).Select
   ActiveSheet.AutoFilterMode = False
   Application.ScreenUpdating = False
End Sub