---

Sub SplitTableTest10()
    Dim wsSource As Worksheet
    Dim wbNew As Workbook
    Dim lastRow As Long, r As Long, countSaved As Long
    Dim savePath As String, fName As String
    Dim uchastok As String, address As String
    Dim ch As Variant, badChars As Variant
    Dim fso As Object

    On Error GoTo ErrHandler

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set wsSource = ActiveSheet
    lastRow = wsSource.Cells(wsSource.Rows.Count, "B").End(xlUp).Row
    
    ' Сохраняем на диск C в папку C:\Output_Excel\ (чтобы исключить любые проблемы с путями)
    savePath = "C:\Output_Excel\"
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(savePath) Then
        fso.CreateFolder savePath
    End If

    badChars = Array("/", "\", ":", "*", "?", """", "<", ">", "|", vbCr, vbLf, Chr(10), Chr(13), Chr(9))
    countSaved = 0

    For r = 2 To lastRow
        ' Пропускаем пустые строки
        If Trim(wsSource.Cells(r, "B").Text) <> "" Then
            
            uchastok = Trim(wsSource.Cells(r, "D").Text)
            address = Trim(wsSource.Cells(r, "F").Text)

            fName = "Row_" & r & "_Uch_" & uchastok & "_" & address
            
            ' Очистка от всех запрещенных символов Windows
            For Each ch In badChars
                fName = Replace(fName, CStr(ch), "_")
            Next ch
            
            fName = Trim(fName)
            If Len(fName) > 120 Then fName = Left(fName, 120)

            ' Создание нового файла
            Set wbNew = Workbooks.Add(1)
            
            ' Копирование шапки и строки данных
            wsSource.Rows(1).Copy wbNew.Sheets(1).Rows(1)
            wsSource.Rows(r).Copy wbNew.Sheets(1).Rows(2)
            
            ' Сохранение (51 = .xlsx)
            wbNew.SaveAs FileName:=savePath & fName & ".xlsx", FileFormat:=51
            wbNew.Close SaveChanges:=False

            countSaved = countSaved + 1
            If countSaved >= 10 Then Exit For
        End If
    Next r

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "Files created: " & countSaved & vbCrLf & "Folder: " & savePath, vbInformation
    Exit Sub

ErrHandler:
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "Error: " & Err.Description, vbCritical
End Sub