Dim sCon$, cn As Object
    Dim finalRow&, lCount&, sSQL$
    Set cn = CreateObject("ADODB.Connection")
    cn.Mode = adModeReadWrite
    Select Case CLng(Split(Application.Version, ".")(0))
    Case Is < 12
        sCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName _
             & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
    Case Is >= 12
        sCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName _
             & ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
    End Select

    cn.Open sCon
                                           
    Dim SheetResult As Worksheet
    Dim SRName As String
    SRName = "Результат"
    If Sh_Exist(ActiveWorkbook, SRName) Then
      Set SheetResult = ActiveWorkbook.Sheets(SRName)
      SheetResult.Delete
    End If
    Set SheetResult = ActiveWorkbook.Sheets.Add(, ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count))
    SheetResult.Name = SRName
    
    Dim rs02 As Object

    sSQL = "SELECT " _
         & "  [Фамилия Имя Отчество], [ИНН-КПП], [Дата регистрации], " _
         & "  instr([Фамилия Имя Отчество], ' ') as frst, " _
         & "  instr(mid([Фамилия Имя Отчество],instr([Фамилия Имя Отчество], ' ')+1,100), ' ') as scnd, " _
         & "  instr([ИНН-КПП], '-') as innkpp, " _
         & "  instr([Дата регистрации], '.') as dd,  " _
         & "  instr(mid([Дата регистрации],instr([Дата регистрации], '.')+1,100), '.') as mm " _
         & "FROM [Список А$]"
    Set rs02 = cn.Execute(sSQL)
    With SheetResult
        .Cells(2, 1).CopyFromRecordset rs02
        .Cells(1, 1).Value = "Фамилия Имя Отчество"
        .Cells(1, 2).Value = "ИНН-КПП"
        .Cells(1, 3).Value = "Дата регистрации"
        .Cells(1, 4).Value = "frst"
        .Cells(1, 5).Value = "scnd"
        .Cells(1, 6).Value = "innkpp"
        .Cells(1, 7).Value = "dd"
        .Cells(1, 8).Value = "mm"
    End With