求助大神，请帮忙修改提取取合并源文件名及工作表名的VBA代码，谢谢！

发布网友发布时间：2022-04-21 02:57

共1个回答

热心网友时间：2023-11-04 20:01

由于不同的表宽度可能不同，合并后的工作簿、工作表名称还是放在A列合适些，代码如下：

Option Explicit

Sub 合并文件夹下所有文件的所有表到一个新表中()

Dim MyPath$, MyName$, i&, n&

Dim st As Worksheet, st1 As Worksheet

Workbooks.Add '新建文件作为汇总结果文件

Set st = ActiveSheet '汇总的结果表

n = 1 '汇总开始的行

MyPath = ThisWorkbook.Path '汇总工具程序所在的文件夹下的所有文件

MyName = Dir(MyPath & "\" & "*.xls")

Do While MyName <> ""

If MyName <> ThisWorkbook.Name Then

With Workbooks.Open(MyPath & "\" & MyName)

For Each st1 In .Worksheets

i = st1.UsedRange.Rows.Count

If i <> 1 Or st1.Cells(1, 1) <> "" Then '跳过空表

st.Cells(n, 1).Resize(i, 1) = .Name & ":" & st1.Name '填名称

st1.UsedRange.Copy st.Cells(n, 2) '复制内容

n = n + i '移动指针到末尾

End If

.Close False

End With

End If

MyName = Dir

Loop

End Sub