Sub rename_other_workbookSheet()
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False


    Dim Path            As String
    Dim FileName        As String
    Dim wb As Workbook
    Dim sht As Worksheet
    Dim ws1 As Worksheet
    
Path = Application.ThisWorkbook.Path

FileName = Dir(Path & "\*.xl*", vbNormal)
Do Until FileName = ""
If InStr(UCase(FileName), "MAPPING_FILE") > 0 Then
Set wb = Workbooks.Open(Path & "\" & FileName)
wb.Activate

For Each sht In wb.Worksheets

    If sht.Name = "Sheet1" Then
        Set ws1 = Worksheets("Sheet1")
        ws1.Name = "Mapping"
        Application.CutCopyMode = False
        ws1.Cells.Copy
        ws1.Cells.PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        End If
        Next sht
        wb.Save
        wb.Close
End If
FileName = Dir()
Loop



Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

I am using this macro to search for a workbook name mapping_file, open it and rename the Sheet1 to Mapping, then remove the formulas inside while retain the values. This macro work wells on my PC but when this macro run on my colleague pc, it wouldn't remove the formula inside. My colleague pc can run other macro file wells but only this macro got problem.

CodePudding user response：

Rename Worksheet in Other Workbooks

Your Code

• The 'Instr business' would not be necessary if you would include it in the Dir:

  FileName = Dir(Path & "\*MaPpIng_fILe*.xl*", vbNormal)
  

• Right below the second occurrence of Application.CutCopyMode = False there should be...

      Exit For ' it was found, no need to loop any further
  End If ' the 'closing' part of 'If sht.Name = "Sheet1" Then'
  

  the End If part being the key mistake.

• You are saving and closing all workbooks, so any of the occurrences of Application.CutCopyMode = False is redundant (try it manually).

• A more efficient way to copy values in place is...

  rg.Value = rg.Value
  

  ... i.e. ...

  ws1.Cells.Value = ws1.Cells.Value
  

  ... possibly even better...

  ws1.UsedRange.Value = ws1.UsedRange.Value
  

• Saving all files (wb.Save), even if there was no processing, is also not efficient (takes time).

This Code

• A 'matching' file (workbook) is processed only if it does not contain a worksheet named Mapping but it contains a worksheet named Sheet1.

Option Explicit

Sub RenameWorksheetInOtherWorkbooks()
    Const ProcTitle As String = "Rename Worksheet in Other Workbooks"
    
    Const swbNamePattern As String = "*Mapping_File*"
    Const swbExtensionPattern As String = ".xl*"
    Const swsOldName As String = "Sheet1"
    Const swsNewName As String = "Mapping"
    
    Application.ScreenUpdating = False
    ' If necessary (often not), out-comment the following and their
    ' respective 'closing' ones below ('True').
    'Application.EnableEvents = False
    'Application.DisplayAlerts = False
    
    Dim twb As Workbook: Set twb = ThisWorkbook
    Dim twbName As String: twbName = twb.Name
    
    Dim swbFolderPath As String: swbFolderPath = twb.Path & "\"
    Dim swbDirPath As String
    swbDirPath = swbFolderPath & swbNamePattern & swbExtensionPattern
    Dim swbName As String: swbName = Dir(swbDirPath)
    ' The correct files are already 'chosen', no need to test in the loop.
    
    Dim swb As Workbook
    Dim sws As Worksheet
    Dim swbCount As Long
    Dim swbOldCount As Long
    Dim swbNewCount As Long
    
    Do Until Len(swbName) = 0
        
        ' Test if not 'ThisWorkbook', the workbook containing this code.
        If Not StrComp(swbName, twbName, vbTextCompare) = 0 Then
            
            swbCount = swbCount   1
            Set swb = Workbooks.Open(swbFolderPath & swbName)
            
            Set sws = Nothing
            On Error Resume Next
            Set sws = swb.Worksheets(swsNewName)
            On Error GoTo 0
            
            ' Test new name.
            If sws Is Nothing Then ' no worksheet with new name
                
                On Error Resume Next
                Set sws = swb.Worksheets(swsOldName)
                On Error GoTo 0
                
                ' Test old name.
                If Not sws Is Nothing Then ' found worksheet with old name
                    ' Only in this case the workbook is processed.
                    swbOldCount = swbOldCount   1
                    sws.Name = swsNewName
                    sws.UsedRange.Value = sws.UsedRange.Value
                    swb.Save
                Else ' no worksheet with old name
                    Debug.Print swb.FullName
                End If
            
            Else ' found worksheet with new name (previously processed)
                
                swbNewCount = swbNewCount   1 ' not testing for old name!
            
            End If
            
            swb.Close False
            
        End If
        
        swbName = Dir
    
    Loop
    
    'Application.DisplayAlerts = True
    'Application.EnableEvents = True
    Application.ScreenUpdating = True
    
    MsgBox "Total workbooks found: " & swbCount & " (with matching pattern)" _
        & vbLf & "Containing worksheet '" & swsOldName & "': " _
        & swbOldCount & " (just processed)" _
        & vbLf & "Containing worksheet '" & swsNewName & "': " _
        & swbNewCount & " (previously processed)" _
        & vbLf & "Containing neither worksheet: " _
        & swbCount - swbOldCount - swbNewCount _
        & " (if any, check out the list in the 'Immediate window' " _
        & "('VBE Ctrl G')", vbInformation, ProcTitle

End Sub