Rename the only worksheet in multiple workbooks in a chosen directory - vba

Question

I am at my wits end and have come to you for your help.
What I am trying to accomplish is to rename a single worksheet (the only worksheet), in multiple workbooks, in a chosen directory to the workbook file name in Excel.
I have found code that will work within a single workbook, however I do not know how to get it to work on multiple workbooks in a directory chosen by the user or ran from a batch/vbs file in the same directory.
Here is the code I was using on a single workbook:
Sub RenameSheet()
Dim wbname
wbname = Replace(ActiveWorkbook.Name, ".xlsx", "")
ActiveSheet.Select
ActiveSheet.Name = wbname
Range("A1").Select
End Sub
I want to be able to do this for all files in a folder chosen by the user or files in the same directory as a batch file/vbs executable file if there is a way to execute this from running either a batch or vbs file?
If there are questions or I have missing something, please let me know and I will answer to the best of my ability.
Any help will be greatly appreciated.

Answer 1

Open File Dialog (Pick which books to modify)
Change sheet name to wbName (your code here)
Close File (Save)
Repeat 2 - 3 for all selected books
This will need modification if there is more than 1 sheet on any of the workbooks selected. IF there is only one sheet, ActiveSheet will suffice.
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.ScreenUpdating = False
'Cycle through books
For FileCount = 1 To ImportFiles.SelectedItems.Count
Set CurrentBook = Workbooks.Open(ImportFiles.SelectedItems(FileCount))
wbName = Replace(CurrentBook.Name, ".xlsx", "")
CurrentBook.Activate
ActiveSheet.Name = wbName
CurrentBook.Close True
Next FileCount
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Answer 2

I had to tweak a couple of lines but this works beautifully. Thank you urdearboy.
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