如何用EXCEL中的VBA合并同一资料夹中，多个工作簿的同一个工作表？

Question

需要建立一个VBA/Marco公式，以便日后可以自动引进同一资料夹中，多个工作簿(workbook)的同一个工作表(sheet)的资料

情况如下：
有工作簿(workbook)1, 2, 3，里面在第一个工作表(sheet1)是同样的样板表格分表代表不同区域的资料。
如何建立一个公式是可以直接截取表1, 2 , 3 的内容成一个总表在新的excel表格上？

不知道有没有高手可以给点建议怎么做？有范例公式可以参考是最好，这样我就可以试写后再请教各位如何改进，叩谢

实际表格类似如下（已移除资料），希望能保留第九列的表头，并合并不同工作表从B至W行，第十列以下的资料（大部分地域资料都远超过第40列，图仅为示例，并不止於第30列）

Answer 1

这个还是容易实现的,我最近刚解决了一个一样的问题,我给你编的能复制第十行以后,如有问题再问我,

sub heb()
application.displayalerts=false
application.screenupdating=false
dim sum
thisworkbook.sheet1.name="汇总"
num=0
myfile=dir (activeworkbook.path & "\*.xls")
if myfile <> "" then
do
  on error resume next
   if myfile=thisworkbook.name then myfile =dir
   workbooks.open(activeworkbook.path & "\" & myfile)
    num=num+1
         if  num =1 then
           Workbooks(myfile).Sheet1.Activate
            Workbooks(myfile).Sheet1.UsedRange.Copy Destination:=thisworkbook.Sheets("汇总").Cells(thisworkbook.Sheets("汇总").Range("A65536").End(xlUp).Row, 1)

         Else
            Workbooks(myfile).Sheet1.Activate
             Workbooks(myfile).Sheet1.UsedRange.Offset(9, 0).Copy Destination:=thisworkbook.Sheets("汇总").Cells(thisworkbook.Sheets("汇总").Range("A65536").End(xlUp).Row + 1, 1)
         End If
         ActiveWorkbook.Close 
         myfile = Dir
  Loop While myfile <> "" And myfile <> ThisWorkbook.Name
End If
Workbooks(ThisWorkbook.Name).Sheets("汇总").Select 
Application.ScreenUpdating = True  
Application.DisplayAlerts = True 
end sub  
 

Answer 2

说千字,不如一附件

 

这里有有我以前做的合并文件夹下所有工作簿(包含子目录)到当前工作表的一个程序

楼主可以参考学习下.

 

也可以把问题作为内容（邮件主题一定要包含“Form”,本人以此为依据辨别非垃圾邮件，以免误删）、excel文件(去掉机密内容)作为附件发来看下 [email protected] 三零三三一三六 二七

本回答被网友采纳