Переименование листов во время выполнения макроса

If oFileSystemObject.FileExists(wb.Path & "" & m & ".xls") Then
            Set srcBook = Workbooks.Open(Filename:=wb.Path & "" & m & ".xls", ReadOnly:=True, UpdateLinks:=0)
If sh.CodeName = "Ив." Then sh.Name = "Иванов": Exit For
ElseIf sh.CodeName = "Пет." Then sh.Name = "Петров": Exit For
ElseIf sh.CodeName = "Сид." Then sh.Name = "Сидоров": Exit For

If Dir(wb.Path & "\" & m & ".xls") <> "" Then
   Set srcBook = Workbooks.Open(Filename:=wb.Path & "\" & m & ".xls", UpdateLinks:=0)
   For Each sh In srcBook.Worksheets '.Sheets
       Select Case LCase(sh.Name)
           Case "ив.": sh.Name = "Иванов"
           Case "пет.": sh.Name = "Петров"
           Case "сид.": sh.Name = "Сидоров"
       End Select
   Next
End If

Sub IMPORT()
    Dim srcBook As Workbook
    Dim ws As Worksheet
    
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Главная")
    Set wf = WorksheetFunction
    Dim oFileSystemObject As Object
    Set oFileSystemObject = CreateObject("Scripting.FileSystemObject")
    Mon = [{"Январь","Февраль","Март"}]
       
    Application.ScreenUpdating = False
    For Each m In Mon
        If oFileSystemObject.FileExists(wb.Path & "" & m & ".xls") Then
            Set srcBook = Workbooks.Open(Filename:=wb.Path & "" & m & ".xls", ReadOnly:=True, UpdateLinks:=0)
If sh.CodeName = "Ив" Then sh.Name = "Иванов": Exit For
ElseIf sh.CodeName = "Пет" Then sh.Name = "Петров": Exit For
ElseIf sh.CodeName = "Сид" Then sh.Name = "Сидоров": Exit For
 
            For Each sh In srcBook.Sheets
                Set wc = ws.Range("A:A").Find(sh.Name)
                If TypeName(wc) = "Range" Then
                    wc.Offset(0, 1).Value = wf.Sum(sh.Range("A3,A7,A9,A11"))
                    wc.Offset(0, 1).Font.Color = vbRed
                End If
            Next sh
            srcBook.Close SaveChanges:=False
        End If
    Next m
    Application.ScreenUpdating = True
End Sub

Option Explicit
 
Private Sub Test()
    Dim wbSource As Workbook, rngTarget As Range
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim strPath As String, strFind As String, varMonth As Variant
    
    strPath = ThisWorkbook.Path & "\"
    Set wsTarget = ThisWorkbook.Worksheets("Главная")
       
    Application.ScreenUpdating = False
    For Each varMonth In Array("Январь", "Февраль", "Март")
        If Len(Dir(strPath & varMonth & ".xls")) Then
           Set wbSource = Workbooks.Open(FileName:=strPath & varMonth & ".xls", UpdateLinks:=0)
            For Each wsSource In wbSource.Worksheets
                strFind = LCase(wsSource.Name)
                Select Case strFind
                    Case "ив.": strFind = "Иванов"
                    Case "пет.": strFind = "Петров"
                    Case "сид.": strFind = "Сидоров"
                End Select
            
                Set rngTarget = wsTarget.Range("A:A").Find(strFind)
                If TypeName(rngTarget) = "Range" Then
                   rngTarget.Offset(0, 1) = Application.Sum(wsSource.Range("A3,A7,A9,A11"))
                   rngTarget.Offset(0, 1).Font.Color = vbRed
                End If
            Next
            wbSource.Close saveChanges:=False
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Case "2810": strFind = "akaDemik"

CodeName = "Лист1" : strFind = "akaDemik"

Option Explicit
 
Private Sub Test()
    Dim wbSource As Workbook, rngTarget As Range
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim strPath As String, strFileName As String, varMonth As Variant
    
    strPath = ThisWorkbook.Path & "\"
    Set wsTarget = ThisWorkbook.Worksheets("Главная")
       
    Application.ScreenUpdating = False
    For Each varMonth In Array("Январь", "Февраль", "Март") 'In Application.GetCustomListContents(4)
        strFileName = Dir(strPath & varMonth & ".xls*")
        If Len(strFileName) > 0 Then
           Set wbSource = Workbooks.Open(Filename:=strPath & strFileName, UpdateLinks:=0)
            For Each wsSource In wbSource.Worksheets
                Set rngTarget = wsTarget.Range("A:A").Find(wsSource.Name & "*")
                If TypeName(rngTarget) = "Range" Then
                   rngTarget.Offset(0, 1) = Application.Sum(wsSource.Range("A3,A7,A9,A11"))
                   rngTarget.Offset(0, 1).Font.Color = vbRed
                End If
            Next
            wbSource.Close saveChanges:=False
        End If
    Next
    Application.ScreenUpdating = True
End Sub

                Select Case strFind
                    Case "Ivan0v": strFind = "Иванов"
                    Case "петр0в": strFind = "Петров"
                    Case "сид": strFind = "Сидоров"
                End Select