Разбить файл на кучу других файлов

'Папка должна существовать
Private Const Папка As String = "D:\ЭкспортТочек"
 
Public Sub Экспорт()
    Dim Индекс As Long
    Dim ЭкспортИндекс As Long
    Dim Область As Range
    Dim ЭкспортОбласть As Range
    Dim Точка As String
    Dim ПредыдущаяТочка As String
    Dim ЭкспортКнига As Workbook
    
    ПредыдущаяТочка = Empty
    Set Область = ThisWorkbook.Worksheets("Рабочий").UsedRange
    Application.ScreenUpdating = False
        Область.Sort Key1:=Область(1, 1), Order1:=xlAscending, _
                    Key2:=Область(1, 2), Order2:=xlAscending, _
                    Key3:=Область(1, 3), Order3:=xlAscending, _
                    Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                    DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:=xlSortNormal
        For Индекс = 2 To Область.Rows.Count
            Точка = Trim(WorksheetFunction.Trim(Область(Индекс, 1).Value))
                If Точка <> ПредыдущаяТочка Then
                    If Not ЭкспортКнига Is Nothing Then
                        ЭкспортОбласть.Columns.AutoFit
                        ЭкспортКнига.SaveAs Filename:=Папка & "\" & ПредыдущаяТочка & ".xls", FileFormat:=xlNormal, CreateBackup:=False
                        ЭкспортКнига.Close
                    End If
                    Set ЭкспортКнига = Application.Workbooks.Add
                    Set ЭкспортОбласть = ЭкспортКнига.Worksheets(1).Cells
                    ЭкспортОбласть(1, 1) = Область(1, 1).Value
                    ЭкспортОбласть(1, 2) = Область(1, 2).Value
                    ЭкспортОбласть(1, 3) = Область(1, 3).Value
                    ЭкспортОбласть(1, 4) = Область(1, 4).Value
                    ЭкспортОбласть.Columns(1).NumberFormat = "General"
                    ЭкспортОбласть.Columns(2).NumberFormat = "#,##0"
                    ЭкспортОбласть.Columns(3).NumberFormat = "#,##0"
                    ЭкспортОбласть.Columns(4).NumberFormat = "#,##0.00"
                    ЭкспортИндекс = 2
                End If
                If IsNumeric(Точка) Then
                    ЭкспортОбласть(ЭкспортИндекс, 1).Value = "'" & Точка
                Else
                    ЭкспортОбласть(ЭкспортИндекс, 1).Value = Точка
                End If
                ЭкспортОбласть(ЭкспортИндекс, 2).Value = Область(Индекс, 2).Value
                ЭкспортОбласть(ЭкспортИндекс, 3).Value = Область(Индекс, 3).Value
                ЭкспортОбласть(ЭкспортИндекс, 4).Value = Область(Индекс, 4).Value
                ЭкспортИндекс = ЭкспортИндекс + 1
            ПредыдущаяТочка = Точка
    Next
    If Not ЭкспортКнига Is Nothing Then
        ЭкспортОбласть.Columns.AutoFit
        ЭкспортКнига.SaveAs Filename:=Папка & "\" & Точка & ".xls", FileFormat:=xlNormal, CreateBackup:=False
        ЭкспортКнига.Close
    End If
    Application.ScreenUpdating = True
    MsgBox "Экспорт завершен", vbOKOnly, "Сообщение макроса"
End Sub

Private Const Папка As String = "D:\ЭкспортТочек"
Private Const КоличествоТочекВКнигеДляЭкспорта = 25
 
Public Sub Экспорт()
    Dim ИндексИмпорт As Long
    Dim ИндексЭкспорт As Long
    Dim ОбластьИмпорт As Range
    Dim ОбластьЭкспорт As Range
    Dim Точка As String
    Dim КнигаЭкспорт As Workbook
    Dim СчетчикТочекНаЭкспорт As Integer
    Dim НазванияТочек As Collection
    Dim ПредыдущаяТочка As String
    
    Application.ScreenUpdating = False
        Set ОбластьИмпорт = ThisWorkbook.Worksheets("Рабочий").UsedRange
            ОбластьИмпорт.Sort Key1:=ОбластьИмпорт(1, 1), Order1:=xlAscending, _
                        Key2:=ОбластьИмпорт(1, 2), Order2:=xlAscending, _
                        Key3:=ОбластьИмпорт(1, 3), Order3:=xlAscending, _
                        Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
                        Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
                        DataOption2:=xlSortNormal, DataOption3:=xlSortNormal
        СоздатьКнигуЭкспорта КнигаЭкспорт, ОбластьЭкспорт, ИндексЭкспорт, ОбластьИмпорт
        Set НазванияТочек = New Collection
        СчетчикТочекНаЭкспорт = 0
        ПредыдущаяТочка = Empty
        For ИндексИмпорт = 2 To ОбластьИмпорт.Rows.Count
            Точка = Trim(WorksheetFunction.Trim(ОбластьИмпорт(ИндексИмпорт, 1).Value))
            If Точка <> ПредыдущаяТочка Then
                СчетчикТочекНаЭкспорт = СчетчикТочекНаЭкспорт + 1
            End If
            If СчетчикТочекНаЭкспорт > КоличествоТочекВКнигеДляЭкспорта Then
                ЗакрытьКнигуЭкспорта КнигаЭкспорт, ОбластьЭкспорт, НазванияТочек
                СоздатьКнигуЭкспорта КнигаЭкспорт, ОбластьЭкспорт, ИндексЭкспорт, ОбластьИмпорт
                Set НазванияТочек = New Collection
                СчетчикТочекНаЭкспорт = 1
            End If
            НазванияТочек.Add Точка
            If IsNumeric(Точка) Then
                ОбластьЭкспорт(ИндексЭкспорт, 1).Value = "'" & Точка
            Else
                ОбластьЭкспорт(ИндексЭкспорт, 1).Value = Точка
            End If
            ОбластьЭкспорт(ИндексЭкспорт, 2).Value = ОбластьИмпорт(ИндексИмпорт, 2).Value
            ОбластьЭкспорт(ИндексЭкспорт, 3).Value = ОбластьИмпорт(ИндексИмпорт, 3).Value
            ОбластьЭкспорт(ИндексЭкспорт, 4).Value = ОбластьИмпорт(ИндексИмпорт, 4).Value
            ИндексЭкспорт = ИндексЭкспорт + 1
            ПредыдущаяТочка = Точка
        Next
        ЗакрытьКнигуЭкспорта КнигаЭкспорт, ОбластьЭкспорт, НазванияТочек
    Application.ScreenUpdating = True
    MsgBox "Экспорт завершен", vbOKOnly, "Сообщение макроса"
End Sub
 
Sub СоздатьКнигуЭкспорта(ByRef КнигаЭкспорт As Workbook, ByRef ОбластьЭкспорт As Range, ByRef ИндексЭкспорт As Long, ByRef ОбластьИмпорт)
    Set КнигаЭкспорт = Application.Workbooks.Add
        Set ОбластьЭкспорт = КнигаЭкспорт.Worksheets(1).Cells
            ОбластьЭкспорт(1, 1) = ОбластьИмпорт(1, 1).Value
            ОбластьЭкспорт(1, 2) = ОбластьИмпорт(1, 2).Value
            ОбластьЭкспорт(1, 3) = ОбластьИмпорт(1, 3).Value
            ОбластьЭкспорт(1, 4) = ОбластьИмпорт(1, 4).Value
            ОбластьЭкспорт.Columns(1).NumberFormat = "General"
            ОбластьЭкспорт.Columns(2).NumberFormat = "#,##0"
            ОбластьЭкспорт.Columns(3).NumberFormat = "#,##0"
            ОбластьЭкспорт.Columns(4).NumberFormat = "#,##0.00"
    ИндексЭкспорт = 2
End Sub
 
Sub ЗакрытьКнигуЭкспорта(ByRef КнигаЭкспорт As Workbook, ByRef ОбластьЭкспорт As Range, ByRef НазванияТочек As Collection)
    ОбластьЭкспорт.Columns.AutoFit
    КнигаЭкспорт.SaveAs Filename:=Папка & "\" & НазванияТочек(1) & "-" & НазванияТочек(НазванияТочек.Count) & ".xls", FileFormat:=xlNormal, CreateBackup:=False
    КнигаЭкспорт.Close
End Sub