excel合并的VBA(宏).docVIP

excel合并的VBA（宏） 合并文件 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) Next ExitSub: Application.ScreenUpdating = True End Sub 合并工作表 Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(what:=*, _ After:=sh.Range(A1), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Sub MergeSheets() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long Dim shLast As Long Dim CopyRng As Range Dim StartRow As Long Application.ScreenUpdating = False Application.EnableEvents = False 新建一个“汇总”工作表 Application.DisplayAlerts = False On Error Resume Next ActiveWorkbook.Worksheets(汇总).Delete On Error GoTo 0 Application.DisplayAlerts = True Set DestSh = ActiveWorkbook.Worksheets.Add DestSh.Name = 汇总 开始复制的行号，忽略表头，无表头请设置成1 StartRow = 2 For Each sh In ActiveWorkbook.Worksheets If sh.Name DestSh.Name Then Last = LastRow(DestSh) shLast = LastRow(sh) If shLast 0 And shLast = StartRow Then Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast)) If Last + CopyRng.Rows.Count DestSh.Rows.Count Then MsgBox 内容太多放不下啦！ Go