利用VBA合并工作表與工作薄.docx

1. 合并Excel工作簿（workbook）新建一個空Excel工作簿，Alt+F11，插入一個模塊，復制以下代碼：Sub MergeWorkbooks() Dim FileSet Dim i As Integer On Error GoTo 0 Application.ScreenUpdating = False FileSet = Application.GetOpenFilename(FileFilter:=Excel 2003(*.xls),*.xls,Excel 2007(*.xlsx),*.xlsx, _MultiSelect:=True, Title:=選擇要合并的文件) If TypeName(FileSet) = Boolean Then GoTo ExitSub End If For Each Filename In FileSet Workbooks.Open Filename Sheets().Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) NextExitSub: Application.ScreenUpdating = TrueEnd Sub2. 合并同一工作簿中的全部工作表（worksheet）打開目標工作簿，再添加一個模塊，代碼如下Sub 合并各工作表內(nèi)容()sp = InputBox(各表內(nèi)容之間，間隔幾行？不輸則默認為0)If sp = Thensp = 0End Ifst = InputBox(各表從第幾行開始合并？不輸則默認為2)If st = Then st = 2End IfSheets(1).SelectSheets.AddIf st 1 Then Sheets(2).Select Rows(1: & CStr(st - 1).Select Selection.Copy Sheets(1).Select Range(A1).Select ActiveSheet.Pastey = st - 1End IfFor i = 2 To Sheets.CountSheets(i).Select For v = 1 To 256 zd = Cells(65535, v).End(xlUp).Row If zd x Then x = zd End If Next vIf y + x - st + 1 + sp 65536 ThenMsgBox 內(nèi)容太多，僅合并前 & i - 2 & 個表的內(nèi)容，請把其它表復制到新工作薄里再用此程序合并！Else:Rows(st & : & x).SelectSelection.CopySheets(1).SelectRange(A & CStr(y + 1).SelectActiveSheet.PasteSheets(i).SelectRange(A1).Select 取消單元格被全選狀態(tài)。Application.CutCopyMode = False 忘掉復制的內(nèi)容。End Ify = y + x - st + 1 + spx = 0Next