Переименовать конкретный лист из подпапок определенной папки

Question

У меня есть несколько файлов Excel в папке, и я хочу переименовать только отдельные листы каждого файла в папке, содержащей

а именно GTLB, SALARY, GROC

Каждый файл имеет один лист вышеперечисленных символов, другие листы имеют разные имена. Таким образом, если имя листа содержит вышеуказанные символы, измените его на GROCERY .

заранее спасибо

Answer 1

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

Answer 2

Попробуйте использовать это, он будет циклически перемещаться по папке, пытаться найти файлы (файлы Excel) и попытаться найти строки в указанных файлах и, если совпадение найдено, изменить имя.

  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