利用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 合并各工作表内容()sp = InputBox(各表内容之间，间隔几行？不输则默认为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 内容太多，仅合并前 & i - 2 & 个表的内容，请把其它表复制到新工作薄里再用此程序合并！Else:Rows(st & : & x).SelectSelection.CopySheets(1).SelectRange(A & CStr(y + 1).SelectActiveSheet.PasteSheets(i).SelectRange(A1).Select 取消单元格被全选状态。Application.CutCopyMode = False 忘掉复制的内容。End Ify = y + x - st + 1 + spx = 0Next