≪EXCEL VBA≫

Sub Macro1()
    
b = ""
c = 2
Sheets("Sheet1").Select
Sheets("Sheet1").Range("A1").Select
Selection.End(xlDown).Select
d = Selection.Row

For a = 2 To d
    If Sheets("Sheet1").Range("A" & a) = "" Then Exit For
        
    If b <> Sheets("Sheet1").Range("A" & a) Then
        b = Sheets("Sheet1").Range("A" & a)
        c = a - 1
        Sheets("Sheet1").Select
        Sheets("Sheet1").Copy After:=Sheets(1)
        ActiveSheet.Name = "worksheet"

        For a2 = d To 2 Step -1
            If b = Sheets("Sheet1").Range("A" & a2) Then
                c2 = a2 + 1
                Exit For
            End If
        Next a2

        If d >= c2 Then
            Sheets("worksheet").Rows(c2 & ":" & d).Select
            Selection.Delete Shift:=xlUp
        End If

        If 2 < c Then
            Sheets("worksheet").Rows("2:" & c).Select
            Selection.Delete Shift:=xlUp
        End If
        

        Sheets("worksheet").Select
        Sheets("worksheet").Move
         
        ActiveWorkbook.SaveAs Filename:=b & ".xls"
        ActiveWorkbook.Close
    End If
Next a
End Sub

実行させる条件として 氏名のエクセルファイルが存在しないこと。

元のシート名は Sheet1

ワークとして worksheet のシート名が利用できること。