以下是引用oaok在2013-12-3 10:59:00的发言：

代码如下，需要能够在Foxtable中运行。

Sub UnionWorksheets()

    Application.ScreenUpdating = False

dim app as MSexcel.application

    Dim lj As String

    Dim dirname As String

    Dim nm As String

 

    lj = "先定义一个路径"

    nm = “文件名”

    dirname = Dir(lj & "\\*.xls*")

 

    ‘Cells.Clear 需要定义全部引用

 

    Do While dirname <> ""

        If dirname <> nm Then

            App.Workbooks.Open Filename:=lj & "\\" & dirname

 

            app.Workbooks(nm).Activate

 

            \'复制新打开工作簿的第一个工作表的已用区域到当前工作表

            app.Workbooks(dirname).Sheets(1).UsedRange.Copy _

                Range("A65536").End(xlUp).Offset(1, 0)

 

            app.Workbooks(dirname).Close False

        End If

        dirname = Dir

    Loop

 

End Sub