VBA学习笔记1：将同个文件夹中的工作簿汇总为一个工作簿，并建立目录超链接

1、将文件夹中的xlsx文件名复制到新工作簿；

2、将文件夹中的xlsx数据簿中的sheet复制到新表并重命名；

3、插入超链接。

效果如下：

代码执行前,有3个工作簿：

执行后，3个工作簿汇总到1个新的工作簿中，并插入超链接：

代码如下：

Sub 汇总文件夹数据()'遍历文件夹数据表，并复制表名Dim file$ 'file是变量Dim num%Dim sht As WorksheetDim k%Application.DisplayAlerts = False '当删除sheet时不再弹出弹框Application.ScreenUpdating = False '屏幕不再闪烁For Each sht In ThisWorkbook.Worksheets '该循环是为了删除新表中的其他数据表If sht.Name <> "sheet1" Then '仅保留了sheet1sht.Delete End IfNext shtfile = Dir(ThisWorkbook.Path & "\*.xlsx") '遍历文件夹下后缀为xlsx的文件Range("a1:a1048576").Clear '清除sheet1中的内容[a1] = "班级" 'a列用来存储各文件的文件名，a1为列名Donum = num + 1 '因为num默认为0，所以+1k = k + 1 'k为了后面新建sheet时引用sheet（k），以防新sheet顺序混乱Worksheets("sheet1").Cells(num + 1, 1) = file '将xlsx的文件名1赋值为a2Workbooks.Open ThisWorkbook.Path & "\" & file '打开文件1ActiveWorkbook.Sheets(1).Copy after:=ThisWorkbook.Sheets(k) '将文件1复制到sheet1后面的sheet中ActiveSheet.Name = file '给新的sheet明明为fileWorkbooks(ThisWorkbook.Path & "\" & file).Close '关闭文件夹中的工作簿ThisWorkbook.Worksheets("sheet1").Hyperlinks.Add anchor:=ThisWorkbook.Worksheets("sheet1").Cells(num + 1, 1), Address:="", SubAddress:="'" & ThisWorkbook.Worksheets(file).Name & "'!a1", ScreenTip:="", TextToDisplay:=file '创建超链接,连接的地址为file名字的sheet的a1单元格，对应的超链接名字为filefile = Dir '循环文件夹中的下一个xlsxLoop Until file = "" '直到文件遍历完结束End Sub

欢迎大家批评指正！谢谢！