Sub Datensätze_verschieben()
Dim r As Long
Dim wsZiel As Worksheet
With Worksheets("Eingabe")
For r = .Range("A99999").End(xlUp).Row To 2 Step -1
Set wsZiel = Worksheet_auswählen(.Cells(r, "B").Value)
Cells(r, 1).EntireRow.Copy wsZiel.Range("A99999").End(xlUp).Offset(1, 0)
Cells(r, 1).EntireRow.Delete Shift:=xlUp
Next
End With
End Sub
Private Function Worksheet_auswählen(WsName As String) As Worksheet
Dim W As Worksheet
On Error Resume Next
Set W = ThisWorkbook.Worksheets(WsName)
If W Is Nothing Then
Set W = ThisWorkbook.Worksheets.Add
W.Name = WsName
End If
Set Worksheet_auswählen = W
End Function