Установка параметров столбца в excel - VB

Sub FileList()
    Dim V As String
    Dim BrowseFolder As String
     
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Выберите папку или диск"
        .Show
        On Error Resume Next
        Err.Clear
        V = .SelectedItems(1)
        If Err.Number <> 0 Then
            MsgBox "Вы ничего не выбрали!"
            Exit Sub
        End If
    End With
    BrowseFolder = CStr(V)
     
    ActiveWorkbook.Sheets.Add
 
    ListFilesInFolder BrowseFolder, True
End Sub

Private Sub ListFilesInFolder(ByVal SourceFolderName As String, ByVal IncludeSubfolders As Boolean)

    Dim objMatches As Object
    Dim objMatches2 As Object
    Dim objMatch As Object
    Dim objMatch2 As Object
 
    Dim strOriginal As String
    Dim strPattern As String
    Dim strPattern2 As String
    Dim ro As Long

    Dim FSO As Object
    Dim SourceFolder As Object
    Dim SubFolder As Object
    Dim FileItem As Object
    Dim r As Long
    Dim str As String

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = FSO.getfolder(SourceFolderName)
 
    r = Range("A65536").End(xlUp).Row + 1
    r2 = Range("A65536").End(xlUp).Row + 1

    For Each FileItem In SourceFolder.Files
        strOriginal = FileItem.Name
        'MsgBox ("Èìÿ: " & strOriginal)
 
        strPattern = "[А-Я\_\Ёёа-я]+"
        strPattern2 = "[0-9]+"
        
        Set objMatches = RegExpFind(FileItem.Name, strPattern, True, True)
        Set objMatches2 = RegExpFind(FileItem.Name, strPattern2, True, True)

        If Not objMatches Is Nothing Then

            If objMatches.Count > 0 Then

                For Each objMatch In objMatches

                    With objMatch
                        Cells(r, 1) = .Value
         
                    End With
 
                    r = r + 1
     
                Next
 
            End If
        End If

        If Not objMatches2 Is Nothing Then

            If objMatches2.Count > 0 Then

                For Each objMatch2 In objMatches2

                    With objMatch2
                        Cells(r2, 3) = .Value
         
                    End With
 
                    r2 = r2 + 1
     
                Next
 
            End If
        End If
        
        X = SourceFolder.Path
        Set FileItem = Nothing
    Next FileItem

    If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            ListFilesInFolder SubFolder.Path, True
        Next SubFolder
    End If
 
    Columns("A:E").AutoFit
 
    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
    Set objMatch = Nothing
    Set objMatches = Nothing
 
End Sub

Public Function RegExpFind(str As String, _
                            Pattern As String, _
                            Optional Globa1 As Boolean = True, _
                            Optional IgnoreCase As Boolean = False, _
                            Optional Multiline As Boolean = True) _
                      As Object
 
    Set RegExpFind = Nothing
     
    If Not str Like "" And Not Pattern Like "" Then
     
        Dim RegExp As Object
         
        Set RegExp = CreateObject("VBScript.RegExp")
        With RegExp
            .Global = Globa1
            .IgnoreCase = IgnoreCase
            .Multiline = Multiline
            .Pattern = Pattern
        End With
         
        On Error Resume Next
        Set RegExpFind = RegExp.Execute(str)
         
        Set RegExp = Nothing
     
    End If
     
End Function