こんばんは。
以下のように作ってみました。ちょっと試してみてください。同名ブックがある時は、そのブックを開いて上書きされます。
終了前に、テンポラリーブック（並び替えに使ったブック）の保存を聞いてきます。保存の時にエラーがあると、エラーメッセージが出て、終了メッセージが出ます。
Option Explicit
Dim msg As String, msgno As Integer
Sub TextDevide2Xls()
Dim Fname As String, FNo As Integer, TextLine As String
Dim i As Long, myArray As Variant
Fname = Application.GetOpenFilename("Txt ファイル(*.txt),*.txt")
If Fname = "False" Then
Exit Sub
End If
Workbooks.Add
Application.ScreenUpdating = False
FNo = FreeFile()
Open Fname For Input As #FNo
Do While Not EOF(1)
Line Input #FNo, TextLine
i = i + 1
myArray = Split(TextLine, ",")
With Cells(i, 1).Resize(, UBound(myArray) + 1)
.NumberFormatLocal = "@"
.Value = myArray
End With
Loop
Close #FNo
With Range("A1").CurrentRegion
.Sort Key1:=Range("C2"), Order1:=xlAscending, _
Key2:=Range("A2"), Order2:=xlAscending, _
Header:=xlYes, _
Orientation:=xlTopToBottom
End With
Application.ScreenUpdating = True
'ユニーク振り分け
Call Xl2NewBk
If Err.Number > 0 Then
msg = "異常"
msgno = 16
End If
MsgBox msg & "終了", msgno
If MsgBox("テンポリラーブックを廃棄しますか？", 32 + vbOKCancel) = vbOK Then
ActiveWorkbook.Close False
If msg <> "" Then ActiveWorkbook.Close False
End If
msg = "": msgno = 0
End Sub
Private Sub Xl2NewBk()
Dim myHead As Variant
Dim i As Long, j As Long, r As String
Dim r1 As Long, r2 As Long
myHead = Range("A1", Range("IV1").End(xlToLeft)).Value
Application.ScreenUpdating = False
With Range("A2", Range("A2").End(xlDown)). _
Resize(, UBound(myHead, 2))
i = 1: j = 1
Do
Do
r = .Cells(j, 3).Value
j = j + 1
Loop While r = .Cells(j, 3).Value
r1 = i
r2 = j - 1
'処理
.Rows(r1 & ":" & r2).Copy
Workbooks.Add
With ActiveWorkbook
.ActiveSheet.Range("A1").Resize(, UBound(myHead, 2)).Value = _
myHead
.ActiveSheet.Range("A2").PasteSpecial
On Error GoTo ErrHandler
Application.DisplayAlerts = False
.SaveAs r
Application.DisplayAlerts = True
.Close
End With
i = j
j = j
Loop Until i > .Rows.Count
End With
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox "Err:" & Err.Number & Chr(13) & _
Err.Description
msg = "異常"
msgno = 16
End Sub
