VBA宏 合并EXCEL
2016-02-04 14:50
260 查看
1、合并多个Excel工作簿
2、合并一个工作簿下多个一致性SHEET
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
2、合并一个工作簿下多个一致性SHEET
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 '新建“汇总”Sheet 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 "超过最大容量!" GoTo ExitSub End If CopyRng.Copy With DestSh.Cells(Last + 1, "A") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With End If End If Next ExitSub: Application.GoTo DestSh.Cells(1) DestSh.Columns.AutoFit Application.ScreenUpdating = True Application.EnableEvents = True End Sub
相关文章推荐
- VB.NET中类对象
- VB.net学习
- VB.NET入门了解
- VB中的常用控件
- 【程序开发小记】VB.NET音乐播放器
- vb.net获取系统特殊文件夹路径方法
- VB6 加载水晶报表例子
- TVB三个台
- VBA AdoDb Load Data from AS400
- VBS 发邮件
- 突发奇想,可直接在github上搜索QPainter(一不小心还搜到了devbean作者的github账号)
- VB6与VB7(VB.NET)的异同
- vm,vbox 虚拟机设置开机自动启动(创建虚拟机快捷方式的命令)
- excel vba访问其他电脑上的excel文件的代码
- VB.NET Winform的一些功能实现
- 三层登录——vb.net
- 三层登录——vb.net
- 海思3536 —— common VB
- 转载 VBA 操作xml
- 初识VB.Net