Gruppe
Allgemein
Problem
Eine Tabelle mit Gruppennamen in Spalte A soll in neu anzulegende Tabellenblätter entsprechend den Gruppennamen aufgeteilt werden.
StandardModule: Modul1
Sub SortSplit()
Dim wks As Worksheet
Dim iRow As Integer, iRowT As Integer
Application.ScreenUpdating = False
Set wks = ActiveSheet
Range("A1").Sort key1:=Range("A2"), order1:=xlAscending, header:=xlYes
iRow = 2
Do Until IsEmpty(wks.Cells(iRow, 1))
If Left(wks.Cells(iRow, 1), 1) <> Left(wks.Cells(iRow - 1, 1), 1) Then
Worksheets.Add after:=Worksheets(Worksheets.Count)
Rows(1).Value = wks.Rows(1).Value
Rows(1).Font.Bold = True
Columns(1).Font.Bold = True
ActiveSheet.Name = Left(wks.Cells(iRow, 1), 1)
iRowT = 1
End If
iRowT = iRowT + 1
Rows(iRowT).Value = wks.Rows(iRow).Value
iRow = iRow + 1
Loop
Worksheets(1).Select
Application.ScreenUpdating = True
End Sub