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

发布网友

我来回答

共1个回答

热心网友

由于不同的表宽度可能不同，合并后的工作簿、工作表名称还是放在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

                Next

                .Close False

            End With

        End If

        MyName = Dir

    Loop

End Sub