把一个文件夹下的所有excel工作簿中的工作表名称改成所在工作簿的名称

文件夹路径：D:\Users\WIN_X\Desktop\1
文件夹内有N个.xls 的工作簿（每个工作簿内只有一个工作表，且所有工作表同名）
需求：把工作表的名称改为所在工作簿的名称，批量操作，不打开工作簿。

举报该问题

推荐答案 2015-09-09

1.单击Excel2007窗口左上角的“Office 按钮”图标，在弹出的菜单中，单击“Excel选项”按钮，如上图所示。

2.在“Excel选项”对话框中,单击左侧“常用”分类，勾选“在功能区显示"开发工具"选项卡”项，单击“确定”按钮返回Excel2007主窗口，即可添加开发工具选项卡。

3.单击“开发工具”菜单-“Visual Basic”图标

4.Excel2007打开代码编辑器窗口，单击“插入”菜单-“模块”菜单项，即可插入默认的模块“模块1”，即可在右侧的VBA代码编辑器窗口输入VBA代码。

Sub Books2Sheets()
    '定义对话框变量
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    '新建一个工作簿
    Dim newwb As Workbook
    Set newwb = Workbooks.Add

    With fd
        If .Show = -1 Then
            '定义单个文件变量
            Dim vrtSelectedItem As Variant

            '定义循环变量
            Dim i As Integer
            i = 1

            '开始文件检索
            For Each vrtSelectedItem In .SelectedItems
                '打开被合并工作簿
                Dim tempwb As Workbook
                Set tempwb = Workbooks.Open(vrtSelectedItem)

                '复制工作表
                tempwb.Worksheets(1).Copy Before:=newwb.Worksheets(i)

                '把新工作簿的工作表名字改成被复制工作簿文件名，这儿应用于xls文件，即Excel97-2003的文件，如果是Excel2007，需要改成xlsx
                newwb.Worksheets(i).Name = VBA.Replace(tempwb.Name, ".xls", "")

                '关闭被合并工作簿
                tempwb.Close SaveChanges:=False

                i = i + 1
            Next vrtSelectedItem
        End If
    End With

    Set fd = Nothing
End Sub

温馨提示：答案为网友推荐，仅供参考

当前网址：http://66.wendadaohang.com/zd/Us9vxvxnsi22s22xU99.html

其他回答

第1个回答 2013-12-13

你用的是Office2003吗,新建一个Excel文件,选择"工具"菜单,"宏","visual basic编辑器",把下边的程序粘进去,然后点击运行,找到你的文件夹,选中所有的工作簿,就可以了.
Sub rename()
Dim FilesToOpen
Dim x As Integer
Application.ScreenUpdating = False
FilesToOpen = Application.GetOpenFilename(FileFilter:="MicroSoft Excel文件(*.xls),*.xls", MultiSelect:=True, Title:="要合并的文件")
If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "没有选中文件"
End If
x = 1
While x <= UBound(FilesToOpen)
Workbooks.Open Filename:=FilesToOpen(x)
ActiveWorkbook.Sheets(1).Name = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4)
ActiveWorkbook.Close SaveChanges:=True
x = x + 1
Wend
Application.ScreenUpdating = True
Application.Quit
End Sub本回答被提问者采纳

第2个回答 2013-12-13

Sub Rename()

    Application.DisplayAlerts = False

    Application.ScreenUpdating = False

    cPath = "D:\Users\WIN_X\Desktop\1\"

    cFile = Dir(cPath & "*.xls")

    Do While cFile <> ""

        wb = Split(cFile, ".")(0)

        If wb <> Split(ThisWorkbook.Name, ".")(0) Then

            With GetObject(cPath & cFile)

                .Sheets(1).Name = wb

                Windows(cFile).Visible = True

                .Close True

            End With

        End If

        cFile = Dir

    Loop

    Application.DisplayAlerts = True

    Application.ScreenUpdating = True

    MsgBox "完成！"

End Sub

第3个回答 2013-12-13

不打开工作薄是修改不了名称的, 只是说, 在后台打开后执行操作, 再关闭掉它

第4个回答 2013-12-13

提取工作簿、工作表名称；
把工作簿名称赋值给工作表名称；
保存；

不会写代码……

相似回答

大家正在搜