[使用VBA合并多个Excel工作簿的几个例子MY.docVIP

使用VBA合并多个Excel工作簿的几个例子 将?许?多?个?工?作?簿?中?的?工?作?表?合?并?到?一?个?工?作?薄?中?,?然?后?对?数?据?进?行?统?计?计?算?,?举?了?几?种?合?并?的?案?例?。 Sub 合并工作簿() Application.DisplayAlerts = False 关闭提示窗口 shes = Application.SheetsInNewWorkbook 工作簿中包含工作表数 Application.SheetsInNewWorkbook = 1 生成的新工作簿中只有一个工作表 Set newbok = Workbooks.Add 生成新工作簿 Set newshe = newbok.Worksheets(1) 新工作表 s = 1 从新工作表的第一行写入数据 na = Dir(d:\123\*.xls) 需要合并的所有工作表都要事先保存在D盘time文件夹下 Do While na Set wb = 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() 取下一个工作簿 Loop Application.SheetsInNewWorkbook = shes Application.DisplayAlerts = True Range(a1).Select End Sub ///把多个工作簿中的第一个工作表中的数据合并到一个工作簿的一个工作表中 Sub Com() Dim MyPath, MyName, AWbName Dim Wb As Workbook, WbN As String Dim G As Long Dim Num As Long Dim BOX As String Application.ScreenUpdating = False MyPath = ActiveWorkbook.Path MyName = Dir(MyPath \ *.xls) AWbName = ActiveWorkbook.Name Num = 0 Do While MyName If MyName AWbName Then Set Wb = Workbooks.Open(MyPath \ MyName) Num = Num + 1 With Workbooks(1).ActiveSheet .Cells(.Range(A65536).End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4) For G = 1 To Wb.Sheets.Count Wb.Sheets(G).UsedRange.Copy .Cells(.Range(A65536).End(xlUp).Row + 1, 1) Next WbN = WbN Chr(13) Wb.Name Wb.Close False End With End If MyName = Dir Loop Range(A1).Select MyName = Dir Loop Range(A1).Select Application.ScreenUpdating = True MsgBox 共合并了 Num 个工作薄下的全部工作表。如下： Chr(13) WbN, vbInformation, 提示 End Sub ///把多个工作簿中所有工作表合并到一个工作表中 Sub Books2Sheets() 定义对话框变量 Dim fd As FileDialog Set fd = Application.FileDialog(msoFileDialogFilePicker) 新建一个工作簿 Dim newwb As Workbook Set newwb = Workbooks.Add With fd If .