#Excel技巧 #办公自动化 #VBA代码 #效率翻倍 #职场神器

   还在为整理几十个Excel文件而头疼吗？每次都要逐个打开查看工作表名称，浪费时间又容易遗漏？今天分享的这个VBA神器，让你一键收集整个文件夹内所有Excel文件的工作表名！

🔥 功能亮点

⚡ 极速收集：1分钟处理上百个文件

📂 智能扫描：自动识别xls、xlsx、xlsm等所有Excel格式

📊 清晰整理：自动生成带序号的文件清单，一目了然

🔍 路径追踪：完整记录每个文件的位置，查找零障碍

Sub 收集目录下所有工作簿内的工作表名()    Dim FolderPath As String    Dim FileName As String    Dim wb As Workbook    Dim ws_count As Long    Dim sht As Worksheet    Dim fso As Object    Dim FolderObj As Object    Dim FileObj As Object    ' 使用文件夹选择对话框选择目录    With Application.FileDialog(msoFileDialogFolderPicker)        .Title = "请选择要扫描的文件夹"        .AllowMultiSelect = False        If .Show <> -1 Then            MsgBox "没有选择文件夹": Exit Sub        End If        FolderPath = .SelectedItems(1)        If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\"    End With    ' 禁用屏幕更新和警告    Application.ScreenUpdating = False    Application.DisplayAlerts = False    ' 清空当前工作簿第一张表的内容    With ThisWorkbook.Sheets(1)        .Cells.Clear        .Range("A1") = "工作簿名称"        .Range("B1") = "工作表名称"        .Range("C1") = "文件路径"        ws_count = 2    End With    ' 创建FileSystemObject对象来遍历文件夹    Set fso = CreateObject("Scripting.FileSystemObject")    Set FolderObj = fso.GetFolder(FolderPath)    ' 遍历文件夹中的所有文件    For Each FileObj In FolderObj.Files        ' 检查文件是否为Excel文件        If LCase(Right(FileObj.Name, 5)) Like "*.xls*" Or _           LCase(Right(FileObj.Name, 4)) = ".xls" Or _           LCase(Right(FileObj.Name, 4)) = ".xla" Then            ' 尝试打开工作簿            On Error Resume Next            Set wb = Workbooks.Open(FileObj.Path, ReadOnly:=True)            On Error GoTo 0            If Not wb Is Nothing Then                ' 在工作簿名称前添加序号                ThisWorkbook.Sheets(1).Cells(ws_count, 1) = "[" & (ws_count - 1) & "] " & wb.Name                ThisWorkbook.Sheets(1).Cells(ws_count, 3) = FileObj.Path                ' 遍历工作簿内的每个工作表                For Each sht In wb.Worksheets                    ThisWorkbook.Sheets(1).Cells(ws_count, 2) = sht.Name                    ws_count = ws_count + 1 ' 行增加1                Next sht                wb.Close SaveChanges:=False                Set wb = Nothing            End If        End If    Next FileObj    ' 如果有子文件夹，也可以添加以下代码来递归遍历子文件夹    ' 如果需要遍历子文件夹，请取消注释下面的代码块    'For Each SubFolder In FolderObj.SubFolders    '    Call ProcessSubFolder(SubFolder.Path)    'Next SubFolder    ' 自动调整列宽    With ThisWorkbook.Sheets(1)        .Columns("A:C").AutoFit        .Range("A1:C1").Font.Bold = True    End With    ' 恢复屏幕更新和警告    Application.ScreenUpdating = True    Application.DisplayAlerts = True    ' 清理对象    Set fso = Nothing    Set FolderObj = Nothing  MsgBox "文件夹内所有工作簿的工作表收集完成！共收集了 " & (ws_count - 2) & " 个工作表。"End Sub

🛠 三步操作

1. 1. 复制代码：将VBA代码粘贴到Excel模块中
2. 2. 运行宏：点击运行，选择目标文件夹
3. 3. 自动生成：秒速生成工作表清单报表

💼 适用场景

• • 项目资料整理归档
• • 数据源文件清查
• • 批量操作前的准备工作
• • 部门文件交接核对

  💡 进阶玩法

这个代码框架还能扩展更多功能：

• • 统计每个工作簿的工作表数量
• • 标记隐藏工作表
• • 提取特定关键词的工作表
• • 生成可视化分析报告

📥 立即获取

工作效率的提升往往来自这些小而美的工具。花5分钟学会这个技巧，未来可能节省你数十小时的手工操作时间！赶快下载示例文件试试吧！

👉 关注公众号后回复 「20260206」 获取下载链接！

记得收藏转发！