这个还是容易实现的,我最近刚解决了一个一样的问题,我给你编的能复制第十行以后,如有问题再问我,
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
说千字,不如一附件
这里有有我以前做的合并文件夹下所有工作簿(包含子目录)到当前工作表的一个程序
楼主可以参考学习下.
也可以把问题作为内容(邮件主题一定要包含“Form”,本人以此为依据辨别非垃圾邮件,以免误删)、excel文件(去掉机密内容)作为附件发来看下 formmr@qq.com 三零三三一三六 二七