Range("A1", "B8").Select 

Name Wert
Franz 67
Huber 34
Huber 56
Karl 45
Meier 45
Meier 56

Sub Makro1()
'hier den Kopierbereich festlegen
Range("A1", "B8").Select

'>>>> ab hier gibts nichts mehr zu ändern
Dim R As Range
Dim name As String
Dim datei As String

Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Set R = Application.Selection


For i = R.Row + 1 To R.Rows.Count
  name = R.Cells(i, R.Column)
  'Schauen, ob der name nochmal vorkommt, um mehrere Zeilen auf einmal zu kopieren
  For j = i + 1 To R.Rows.Count
      If name <> R.Cells(j, R.Column) Then
        j = j - 1
        Exit For
      End If
  Next j
  'Der Kopierbereich von Zeile i bis zeile j innerhalb der selektierten Spalten
  Range(R.Cells(i, R.Column), R.Cells(j, R.Columns(R.Columns.Count).Column)).Select
  Selection.Copy
  'Startzeile für das nächste Kopieren setzen
  i = j
  'Ist die Exceldatei des MA vorhanden
  datei = Dir(name & ".XLS")
  ' Wenn das Feld name leer ist, passiert nichts
  If name <> "" Then
    If datei = "" Then
  '     In neue exceldatei kopieren bei neuem MA-namen
        Set NewBook = Workbooks.Add
        Worksheets("Tabelle1").Activate
        ActiveSheet.Paste Destination:=Cells(1, 1)
        NewBook.SaveAs Filename:=name & ".XLS"
        Workbooks(name & ".XLS").Close
      Else
  '     In vorhandene Exceldatei kopieren
        Workbooks.Open name & ".XLS"
        Worksheets("Tabelle1").Activate
        letzteZeile = Range("A65536").End(xlUp).Row
        ActiveSheet.Paste Destination:=Cells(letzteZeile + 1, 1)
        Workbooks(name & ".XLS").Close SaveChanges:=True
    End If
  End If
  
Next i
' das wars vom Mars
End Sub