Vba 重命名选定目录中多个工作簿中的唯一工作表

我束手无策，来找你帮忙

我试图完成的是将多个工作簿中选定目录中的单个工作表（唯一的工作表）重命名为Excel中的工作簿文件名

我发现了可以在单个工作簿中工作的代码，但是我不知道如何让它在用户选择的目录中的多个工作簿上工作，或者从同一目录中的batch/vbs文件运行

以下是我在单个工作簿上使用的代码：

Sub RenameSheet()
Dim wbname
wbname = Replace(ActiveWorkbook.Name, ".xlsx", "")
    ActiveSheet.Select
    ActiveSheet.Name = wbname
    Range("A1").Select
End Sub

我希望能够对用户选择的文件夹中的所有文件或与批处理文件/vbs可执行文件位于同一目录中的文件执行此操作（如果有办法通过运行批处理文件或vbs文件执行此操作）

如果有问题或我遗漏了什么，请让我知道，我会尽我所能回答

任何帮助都将不胜感激

“打开文件”对话框（选择要修改的书籍）

将工作表名称更改为wbName（此处为您的代码）

关闭文件（保存）

对所有选定的书籍重复2-3

如果选择的任何工作簿上有1张以上的工作表，则需要修改。如果只有一张工作表，

ActiveSheet

就足够了

    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

---

我不得不调整了几行，但效果很好。谢谢你，孩子

    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

---

什么是

FileIdx

？@GMalc肯定是打字错误，他正在尝试获取下一个文件计数。我有一个待更新的editUpdated，应该按照预期工作（刚刚测试过），我对我的进行了编辑。我打开了两次

displayerts

。需要进行

屏幕更新

，这将加快运行速度。再次感谢您。我已经适应了你的变化。