欢迎来到天天文库
浏览记录
ID:55505825
大小:24.50 KB
页数:6页
时间:2020-05-15
《使用VBA并多个Excel工作簿的几个例子 MY.doc》由会员上传分享,免费在线阅读,更多相关内容在行业资料-天天文库。
1、使用VBA合并多个Excel工作簿的几个例子将许多个工作簿中的工作表合并到一个工作薄中,然后对数据进行统计计算,举了几种合并的案例。Sub合并工作簿() Application.DisplayAlerts=False'关闭提示窗口 shes=Application.SheetsInNewWorkbook'工作簿中包含工作表数 Application.SheetsInNewWorkbook=1'生成的新工作簿中只有一个工作表 Setnewbok=Workbooks.Add'生成新工作簿 Setnewshe=newbok.Worksheets(1)'新工作表 s=1'从新工作表的第一行写入数据
2、 na=Dir("d:123*.xls")'需要合并的所有工作表都要事先保存在D盘time文件夹下 DoWhilena<>"" Setwb=Application.Workbooks.Open("d:123"&na) wb.Worksheets(1).UsedRange.Copy'复制数据 newbok.Activate Cells(s,1).Select ActiveSheet.Paste'执行粘贴 s=newshe.UsedRange.Rows.Count+1 Cells(s,1)=wb.Name'写入数据所属的工作簿名字 s=s+1 wb.Close'关闭工作簿 na=Dir
3、()'取下一个工作簿 Loop Application.SheetsInNewWorkbook=shes Application.DisplayAlerts=True Range("a1").Select EndSub ///把多个工作簿中的第一个工作表中的数据合并到一个工作簿的一个工作表中 SubCom() DimMyPath,MyName,AWbName DimWbAsWorkbook,WbNAsString DimGAsLong DimNumAsLong DimBOXAsString Application.ScreenUpdating=False MyPath=ActiveW
4、orkbook.Path MyName=Dir(MyPath&""&"*.xls") AWbName=ActiveWorkbook.Name Num=0 DoWhileMyName<>"" IfMyName<>AWbNameThen SetWb=Workbooks.Open(MyPath&""&MyName) Num=Num+1 WithWorkbooks(1).ActiveSheet .Cells(.Range("A65536").End(xlUp).Row+2,1)=Left(MyName,Len(MyName)-4) ForG=1ToWb.Sheets.Count Wb.Shee
5、ts(G).UsedRange.Copy.Cells(.Range("A65536").End(xlUp).Row+1,1) Next WbN=WbN&Chr(13)&Wb.Name Wb.CloseFalse EndWith EndIf MyName=Dir Loop Range("A1").SelectMyName=Dir Loop Range("A1").Select Application.ScreenUpdating=True MsgBox"共合并了"&Num&"个工作薄下的全部工作表。如下:"&Chr(13)&WbN,vbInformation,"提示" EndSub //
6、/把多个工作簿中所有工作表合并到一个工作表中 SubBooks2Sheets() '定义对话框变量 DimfdAsFileDialog Setfd=Application.FileDialog(msoFileDialogFilePicker) '新建一个工作簿 DimnewwbAsWorkbook Setnewwb=Workbooks.Add Withfd If.Show=-1Then '定义单个文件变量 DimvrtSelectedItemAsVariant '定义循环变量 DimiAsInteger i=1 '开始文件检索 ForEachvrtSelectedItemIn.S
7、electedItems '打开被合并工作簿 DimtempwbAsWorkbook Settempwb=Workbooks.Open(vrtSelectedItem) '复制工作表 tempwb.Worksheets(1).CopyBefore:=newwb.Worksheets(i) '把新工作簿的工作表名字改成被复制工作簿文件名,这儿应用于xls文件,即Excel97-2003的文件,如果是Excel2007,需
此文档下载收益归作者所有