【会EXCEL就会用】EXCEL VBA 一键批量获取当前文件夹下面所有工作簿里所有工作表，移动到到当前工作簿，并列出清单，一次制作，永久使用。工具/原料moreEXCEL2010更多经验请关注，如果帮到了你，请在上方给个投票谢谢支持。 方法/步骤1/9分步阅读

【准备条件1】新建专用文件夹。

2/9

【准备条件2】在文件夹内放若干EXCEL文件备用，格式、内容、数量不限。

3/9

【开始制作】在该文件夹下新建EXCEL工作簿，并将工作表1改名为导入清单，A1输入工作簿名称、B1输入工作表名称。

4/9

【打基础1】从左上角文件里面找到EXCEL选项设置，打开选择自定义功能区，将里面的开发工具选项打勾，确定保存。

5/9

【打基础2】删除sheet2、sheet3，只留导入清单，文件保存为 启用宏的工作簿（*.xlsm）

6/9

【关键步骤】从开发工具里打开Visual Basic, 新建模块1，将以下代码复制到里面，保存，关闭代码窗口。

Public Sub 一键获取本文件夹工作表()

Application.ScreenUpdating = False

Dim f As String, i As Integer

Dim wb As Excel.Workbook

Dim sh, sh1 As Excel.Worksheet

Set sh1 = ThisWorkbook.Worksheets(导入清单)

If Range(a65536).End(xlUp).Row 1 Then

sh1.Range(a2:b Range(a65536).End(xlUp).Row).Clear

End If

f = Dir(ThisWorkbook.Path \*xls*)

Do While f

If f ThisWorkbook.Name Then

Set wb = Workbooks.Open(ThisWorkbook.Path \ f)

For i = 1 To Sheets.Count

sh1.Range(a sh1.Range(a65536).End(xlUp).Row + 1) = wb.Name

sh1.Range(b sh1.Range(b65536).End(xlUp).Row + 1) = Sheets(i).Name

Next

Worksheets.Copy Before:=Workbooks(ThisWorkbook.Name).Sheets(1)

wb.Close True

End If

f = Dir

Loop

sh1.Select

Application.ScreenUpdating = True

MsgBox 已为您成功导入 Sheets.Count - 1 张工作表, , VBA交流QQ15678768

End Sub

7/9

【再来一步】从开发工具，插入，表单控件，选择按钮。

8/9

【接近尾声】在任意空白位置拖动鼠标画一个按钮，跳出指定宏对话框，

选择“一键获取本文件夹工作表“，确定保存。

9/9

【大功告成】点击按钮，查看效果。