Public Sub SplitString()
    
    Dim rngTable As Range
    Dim rngStrings As Range
    Dim wksCurrent As Worksheet
    Dim wksNew As Worksheet
    
    Set wksCurrent = ThisWorkbook.ActiveSheet
    Set wksNew = ThisWorkbook.Worksheets.Item("Лист2")
    Set rngTable = Selection
    Set rngStrings = rngTable.Columns.Item(3)
    
    Dim i As Long
    Dim lInsertingRow As Long
    Dim lPosition As Long
    Dim sFirstPart As String
    Dim sSecondPart As String
    
    wksCurrent.Rows.Item(1).Copy Destination:=wksNew.Cells(1, 1)
    lInsertingRow = 2
    
    For i = 1 To rngStrings.Rows.Count Step 1
        
        lPosition = InStr(rngStrings.Cells(i, 1).Value, "(")
        
        If lPosition > 1 Then
        
            sFirstPart = Trim(Left(rngStrings.Cells(i, 1).Value, lPosition - 1))
            sSecondPart = Trim(Right(rngStrings.Cells(i, 1).Value, Len(rngStrings.Cells(i, 1).Value) - Len(sFirstPart)))
            sSecondPart = Replace(sSecondPart, "(", "")
            sSecondPart = Replace(sSecondPart, ")", "")
            
            wksNew.Cells(lInsertingRow, 1).Value = rngTable.Cells(i, 1)
            wksNew.Cells(lInsertingRow, 2).Value = rngTable.Cells(i, 2)
            wksNew.Cells(lInsertingRow, 3).Value = sFirstPart
            wksNew.Cells(lInsertingRow, 4).Value = rngTable.Cells(i, 4)
            
            wksNew.Cells(lInsertingRow + 1, 1).Value = rngTable.Cells(i, 1)
            wksNew.Cells(lInsertingRow + 1, 2).Value = rngTable.Cells(i, 2)
            wksNew.Cells(lInsertingRow + 1, 3).Value = sSecondPart
            wksNew.Cells(lInsertingRow + 1, 4).Value = rngTable.Cells(i, 4)
            
            lInsertingRow = lInsertingRow + 2
        Else
            rngTable.Rows.Item(i).Copy Destination:=wksNew.Cells(lInsertingRow, 1)
            lInsertingRow = lInsertingRow + 1
        End If
        
    Next i
    
    Set wksCurrent = Nothing
    Set wksNew = Nothing
    Set rngTable = Nothingn
    Set rngStrings = Nothing
    
End Sub

Public Sub WriteData()

    'Определяем диапазон с ИНН данными
    Dim rngINN As Range
    Set rngINN = Intersect(ThisWorkbook.ActiveSheet.UsedRange, Columns.Item(3))
    
    Dim i As Long                       'счетчик
    Dim sFileName As String             'имя файла
    Dim sPath As String                 'путь к папке с файлами ИНН
    sPath = "C:\"                       'Указать папку с файлами, заканчивающуюся обратным слэшем
    
    'Перебор всех ИНН
    For i = 5 To rngINN.Rows.Count Step 1
        sFileName = Dir(sPath & rngINN.Cells(i, 1).Value & ".xls", vbNormal)   'Проверяем наличие файла
        If Len(sFileName) <> 0 Then                                     'Если файл есть, то
            'Открываем файл, вписываем значения куда надо, закрываем
        End If
    Next i
    
    Set rngINN = Nothing
    
End Sub

MyRange.ClearContents