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

Question

У меня есть папка с файлами CSV. Все они имеют одинаковую структуру данных, и для каждой книги есть только один рабочий лист. Все они имеют разные имена листов, обычно это дата. Я хотел бы преобразовать все имена рабочих листов в одно и то же во всех книгах, что-то вроде «RenamedSheet» (или что-нибудь действительно). У меня есть код, который меняет имя листа на имя книги. Я просто хочу, чтобы одно имя рабочего листа было выбрано во всех рабочих книгах.

Sub RenameSheet()

Dim CurrentBook As Workbook
Dim ImportFiles As FileDialog
Dim FileCount As Long 'Count of workbooks selected
Dim wbName As String

'Open File Picker
Set ImportFiles = Application.FileDialog(msoFileDialogOpen)
With ImportFiles
    .AllowMultiSelect = True
    .Title = "Pick Files to Adjust"
    .ButtonName = ""
    .Filters.Clear
    .Filters.Add ".xlsx files", "*.xlsx"
    .Show
End With

Application.DisplayAlerts = False
Application.DisplayAlerts = False

'Cycle through books
For FileCount = 1 To ImportFiles.SelectedItems.Count
    Set CurrentBook = Workbooks.Open(ImportFiles.SelectedItems(FileCount))
        wbName = Replace(CurrentBook.Name, ".xlsx", "") ' had to rework this line to the original
        CurrentBook.Activate
        ActiveSheet.Name = wbName
        CurrentBook.Close True
Next FileCount ' had to change this to FileCount to remove the error "invalid next control variable"

Application.DisplayAlerts = True
Application.DisplayAlerts = True

End Sub

Как изменить код, чтобы он переименовал все рабочие листы в выбранных рабочих книгах, чтобы мы произнесли «Переименовать»

Спасибо за любую помощь!

Answer 1

Пожалуйста, замените соответствующую часть вашего кода следующим.

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

'Cycle through books
For FileCount = 1 To ImportFiles.SelectedItems.Count
    Set CurrentBook = Workbooks.Open(ImportFiles.SelectedItems(FileCount))
        ' Excel activates the CurrentBook on Open
        With CurrentBook
            ' if there is only one sheet its index must be 1
            .Sheets(1).Name = "New Name"
            .Close True
        End With
Next FileCount

With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
End With