---

Sub SplitToFilesByAddress_Final()
    Dim wsSource As Worksheet
    Dim wbNew As Workbook
    Dim wsNew As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim addressVal As String
    Dim safeFileName As String
    Dim savePath As String
    
    ' Check if file is saved
    If ThisWorkbook.Path = "" Then
        MsgBox "Please save this main file to a folder on your PC first.", vbExclamation
        Exit Sub
    End If
    
    ' Create final folder
    savePath = ThisWorkbook.Path & "\Split_Addresses_Final\"
    If Dir(savePath, vbDirectory) = "" Then
        MkDir savePath
    End If
    
    Set wsSource = ThisWorkbook.ActiveSheet
    
    ' Find the real last row in column B (Names)
    lastRow = wsSource.Cells(wsSource.Rows.Count, "B").End(xlUp).Row
    
    ' Optimize speed
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ' Start from row 3, go until the end of the table
    For i = 3 To lastRow
        addressVal = wsSource.Cells(i, 6).Text ' Column F is 6
        
        ' If address is empty, name it "Dom_" + row number to avoid overwriting
        If Trim(addressVal) = "" Then
            safeFileName = "Dom_" & i
        Else
            ' Clean filename from bad characters
            safeFileName = addressVal
            safeFileName = Replace(safeFileName, "/", "_")
            safeFileName = Replace(safeFileName, "\", "_")
            safeFileName = Replace(safeFileName, ":", "_")
            safeFileName = Replace(safeFileName, "*", "_")
            safeFileName = Replace(safeFileName, "?", "_")
            safeFileName = Replace(safeFileName, """", "_")
            safeFileName = Replace(safeFileName, "<", "_")
            safeFileName = Replace(safeFileName, ">", "_")
            safeFileName = Replace(safeFileName, "|", "_")
        End If
        
        ' Create new file
        Set wbNew = Workbooks.Add
        Set wsNew = wbNew.Sheets(1)
        
        ' Copy header (Row 2) to the first row of new file
        wsSource.Rows(2).Copy
        wsNew.Rows(1).PasteSpecial Paste:=xlPasteAll
        wsNew.Rows(1).PasteSpecial Paste:=xlPasteColumnWidths
        
        ' Copy data to the second row of new file
        wsSource.Rows(i).Copy
        wsNew.Rows(2).PasteSpecial Paste:=xlPasteAll
        
        ' Save and close
        wbNew.SaveAs Filename:=savePath & safeFileName & ".xlsx", FileFormat:=xlOpenXMLWorkbook
        wbNew.Close SaveChanges:=False
    Next i
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    MsgBox "All Done! Created files in: " & savePath, vbInformation
End Sub