Rename specific sheet from specific folder sub folders - excel

Question

I have several excel files in folder & want to rename only specific sheets of every file in the folder which contains
viz. GTLB, SALARY, GROC
Every file has a single sheet of above characters, other sheets have different names.
So, if sheet name contains above characters then change it to GROCERY.
thanks in advance

Answer 1

Try using this it will loop through the folder try finding files (excel files) and try looking for the strings in files that have been specified and if match found change the name.
Sub LoopThroughFiles()
'loops through all files in a folder
Dim MyObj As Object, MySource As Object, file As Variant
Dim wbk As Workbook
Dim path As String
Dim st As String
file = Dir("H:\TestCopy\testing\") 'file name
path = "H:\TestCopy\testing\" 'directory path
While (file <> "")
Set wbk = Workbooks.Open("H:\TestCopy\testing\" & file)
MsgBox "found " & file
' path = path & file 'path and filename
Call newloopTrhoughBooks
wbk.Save
wbk.Close
' Call loop_through_all_worksheets(path)
file = Dir
Wend
End Sub
Sub newloopTrhoughBooks()
Dim book As Workbook, sheet As Worksheet, text As String, text1 As String
Dim logic_string As String
Dim logic_string2 As String
Dim logic_string3 As String
logic_string = "GTLB"
logic_string2 = "SALARY"
logic_string3 = "GROC"
For Each book In Workbooks
text = text & "Workbook: " & book.Name & vbNewLine & "Worksheets: " & vbNewLine
For Each sheet In book.Worksheets
text = text & sheet.Name & vbNewLine
text1 = sheet.Name
If StrComp(logic_string, text1) = 1 Or StrComp(logic_string2, text1) = 1 Or StrComp(logic_string3, text1) = 1 Then 'compare file name
ActiveSheet.Name = text1
ActiveSheet.Name = "Change1"
End If
Next sheet
text = text & vbNewLine
Next book
MsgBox text
End Sub

Answer 2

Sub RenameSheets()
Dim MyFolder As String
Dim MyFile As String
Dim wbname As String
MyFolder = "E:\SSS\File Name"
MyFile = Dir(MyFolder & "\*.xls")
Application.ScreenUpdating = False
Do While MyFile <> ""
Workbooks.Open Filename:=MyFolder & "\" & MyFile
With ActiveWorkbook
wbname = "GROCERY"
'For giving filename to sheet1
'Left(.Name, InStr(.Name, ".") - 1)
For Each sheet In ActiveWorkbook.Sheets
If LCase(sheet.Name) Like "*salary*" Or LCase(sheet.Name) Like "*gtlb*" Or LCase(sheet.Name) Like "*groc*" Then
MsgBox "Found! " & sheet.Name
.Sheets(sheet.Name).Name = wbname
.Close savechanges:=True
End If
Next
'.Sheets(1).Name = wbname
'.Close savechanges:=True
End With
MyFile = Dir
Loop
Application.ScreenUpdating = True
End Sub