轻轻一点，工作簿自动合并。

POI988

谢谢分享！！！

qsqs

要好好研究研究

泡泡up

为什么我下下来完全用不了，抓墙！！！

SoWhatメ

不错，谢谢楼主，辛苦了！

达州张先生

应该增加一句，限制只汇总一次，现在的表重复汇总了。

佛山小老鼠

达州张先生 发表于 2013-11-18 18:13
应该增加一句，限制只汇总一次，现在的表重复汇总了。

你自己在汇总之前要加上清除原有的数据的代码,就不会重复了
Sub 工作簿汇总()
Call 清除
For Each st In Worksheets
If st.Name <> ActiveSheet.Name Then st.UsedRange.Offset(1, 0).Copy Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Next
End Sub

Sub 按钮1_单击()
   Dim myPath$, myFile$, AK As Workbook, aRow%, tRow%, i As Integer
   Call 清除
   Application.ScreenUpdating = False        '冻结屏幕，以防屏幕抖动
   myPath = ThisWorkbook.Path & "\分表\"          '把文件路径定义给变量
   
   myFile = Dir(myPath & "*.xls")            '依次找寻指定路径中的*.xls文件
   Do While myFile <> ""                     '当指定路径中有文件时进行循环
      If myFile <> ThisWorkbook.Name Then
         Set AK = Workbooks.Open(myPath & myFile)          '打开符合要求的文件
          For i = 1 To AK.Sheets.Count
         aRow = AK.Sheets(i).Range("a65536").End(xlUp).Row
         tRow = ThisWorkbook.Sheets(1).Range("a65536").End(xlUp).Row + 1
            'AK.Sheets(i).Select
         AK.Sheets(i).Range("a2:k" & aRow).Copy ThisWorkbook.Sheets(1).Range("a" & tRow)
         Next
         Workbooks(myFile).Close False               '关闭源工作簿,并不作修改
      End If
      myFile = Dir                                   '找寻下一个*.xls文件
   Loop
      
   Application.ScreenUpdating = True                 '冻结屏幕,此类语句一般成对使用
   MsgBox "汇总完成，请查看！", 64, "提示"

End Sub

佛山小老鼠

泡泡up 发表于 2013-11-18 14:50
为什么我下下来完全用不了，抓墙！！！

这位朋友,你要能懂别人的代码懂,然后你才知道怎么用,你说一下,你全乱了,说来听听

wenwen000424

作个记号，以便学习。

达州张先生

佛山小老鼠 发表于 2013-11-19 01:07
你自己在汇总之前要加上清除原有的数据的代码,就不会重复了
Sub 工作簿汇总()
Call 清除

谢谢指教，

huaich

多工作簿汇总，怎么点击汇总按钮无变化