VBA-Programmierung in Microsoft Excel

Tutorial: Excel-Beispiele

Aufteilen einer Tabelle auf mehrere Arbeitsblätter

Gruppe

Allgemein

Bereich

Kopieren

Thema

Aufteilen einer Tabelle auf mehrere Arbeitsblätter

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

    


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