Excel Makro erstellen zur Sortierung

Public Sub Sort()
    Dim Row As Integer, Row2 As Integer, SortCriterium As String
    Row = 1
    Sheets("Zentral").Activate  
    Do Until Cells(Row, 1).Value = ""  
        SortCriterium = Cells(Row, 3)
        If Not SheetExists(SortCriterium) Then
            Sheets.Add After:=Sheets(Sheets.Count)
            Sheets(Sheets.Count).Name = SortCriterium
        End If
        Sheets("Zentral").Activate  
        Rows(Row & ":" & Row).Select  
        Selection.Copy
        Sheets(SortCriterium).Activate
        Row2 = 1
        Do Until Cells(Row2, 1) = ""  
            Row2 = Row2 + 1
        Loop
        Rows(Row2 & ":" & Row2).Select  
        ActiveSheet.Paste
        Sheets("Zentral").Activate  
        Row = Row + 1
    Loop
    Dim objWorksheet As Worksheet
    For Each objWorksheet In ActiveWorkbook.Worksheets
        If objWorksheet.Name <> "Zentral" Then  
            objWorksheet.Select
            ActiveWorkbook.Windows(1).SelectedSheets.Copy
            Application.DisplayAlerts = False
            ActiveWorkbook.SaveAs objWorksheet.Name
            Application.DisplayAlerts = True
            ActiveWorkbook.Close
        End If
    Next
End Sub

Public Function SheetExists(Worksheetname As String) As Boolean
Dim objWorksheet As Worksheet
  For Each objWorksheet In ActiveWorkbook.Worksheets
    If objWorksheet.Name = Worksheetname Then SheetExists = True: Exit For
  Next
End Function