在一个文件夹内有多个工作簿，每个工作簿里有一个工作表，如何利用vb将工作表的名称批量改成对应工作簿的名称

在VBA中，如果你想将一个包含多个工作簿的文件夹内的工作表名称批量改为对应的每个工作簿的名称，你可以编写一个宏来遍历所有工作簿和工作表，并根据工作簿的名称进行调整。以下是一个基本的示例：

Sub BatchRenameWorksheetByWorkbook()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim wbName As String
    Dim wsNewName As String
    Dim folderPath As String ' 设置你要操作的文件夹路径

    ' 设置文件夹路径
    folderPath = "C:\YourFolder\" ' 请替换为实际文件夹路径

    ' 遍历文件夹中的每个工作簿
    Application.ScreenUpdating = False ' 关闭屏幕更新提高性能
    Set wb = Workbooks.Open(Folder:=FolderPath)
    Do While wb Is Nothing '<-- 这里假设文件夹内都是Excel文件
        Try
            wbName = wb.FullName ' 获取工作簿全名
            wsNewName = Left(wbName, InStrRev(wbName, "\")) '<-- 取消文件路径后的部分作为新工作表名
            wsNewName = Replace(wsNewName, ".xlsx", "") '<-- 移除".xlsx"

            ' 检查是否存在同名的工作表，如果有则添加编号避免冲突
            If wsExists(wsNewName, wb) Then
                wsNewName = wsNewName & "_" & Format(Now(), "dd-mm-yyyy_hh-mm") '<-- 添加时间戳作为后缀
            End If
            
            ' 更改工作表名称
            ws = wb.Sheets(1) ' 假设工作簿只有一个工作表，如果是多张，这里需要更改
            ws.Name = wsNewName
            MsgBox "工作表 '" & ws.Name & "' 的名称已改为 '" & wbName & "'", vbInformation
        Catch ex As Exception
            MsgBox ex.Message, vbExclamation, "错误"
        Finally
            wb.Close SaveChanges:=False ' 仅关闭工作簿，不保存更改
        End Try
    Loop
    Application.ScreenUpdating = True ' 重新开启屏幕更新
End Sub

Function wsExists(wsName As String, wb As Workbook) As Boolean
    On Error Resume Next
    wsExists = Not (wb.Worksheets(wsName) Is Nothing)
    On Error GoTo 0
End Function