AW: neue Tabelle für Kabelname
17.10.2024 15:41:35
daniel
Hi
als VBA-Makro würde es so funktionieren:
Sub test()
Dim x1 As Range
Dim x2 As Range
Dim i As Long
Application.DisplayAlerts = False
For i = 2 To ThisWorkbook.Sheets.Count
ThisWorkbook.Sheets(2).Delete
Next
Application.DisplayAlerts = True
With ThisWorkbook.Sheets(1)
Set x2 = .Cells(1, 3)
.UsedRange.Sort key1:=x2, order1:=xlAscending, Header:=xlYes
Do
Set x1 = x2.Offset(1, 0)
If x1.Value = "" Then Exit Do
Set x2 = x1.EntireColumn.Find(what:=Split(x1.Value, "+")(0) & "*", lookat:=xlWhole, searchdirection:=xlPrevious)
ThisWorkbook.Sheets.Add after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ActiveSheet.Name = Split(x1.Value, "+")(0)
.Rows(1).Copy ActiveSheet.Cells(1, 1)
Range(x1, x2).EntireRow.Copy ActiveSheet.Cells(2, 1)
Loop
End With
End Sub
wenn neue Daten kommen oder es Änderungen an der Gesamttabelle gibt, muss man das Makro nochmal laufen lassen.