Option Explicit
Public Sub MyLittleHelper()
Dim wks As Excel.Worksheet
Dim rngTable As Excel.Range
Dim rngCell As Excel.Range
Set wks = ThisWorkbook.Worksheets("Tabelle1")
Set rngCell = wks.Range("A1")
Set rngTable = rngCell.CurrentRegion
Call rngTable.Sort(Key1:=rngTable.Cells(1, 1), Order1:=xlAscending, _
Key2:=rngTable.Cells(1, 2), Order2:=xlAscending, _
SortMethod:=xlPinYin, _
Header:=xlNo)
Dim rngCellPrev As Excel.Range
Dim strNamePrev As String
For Each rngCell In rngTable.Columns(1).Cells
If strNamePrev <> "" Then
If rngCell.Text <> strNamePrev Then
Set rngCellPrev = rngCell.Offset(-1)
Call rngCell.Resize(ColumnSize:=rngTable.Columns.Count).Insert(xlShiftDown)
With rngCell.Offset(-1).Resize(1, 2)
.Value = Array(strNamePrev, rngCellPrev.Offset(ColumnOffset:=1).Value + 1)
End With
strNamePrev = rngCell.Text
End If
Else
strNamePrev = rngCell.Text
End If
Next
Set rngCell = rngTable.Cells(rngTable.Rows.Count, 1).Offset(1)
Set rngCellPrev = rngCell.Offset(-1)
With rngCell.Offset(-1).Resize(1, 2)
.Value = Array(strNamePrev, rngCellPrev.Offset(ColumnOffset:=1).Value + 1)
End With
End Sub