多个excel工作簿汇总,同一工作簿中sheets合并

来源:互联网 发布:北京 软件联盟 编辑:程序博客网 时间:2024/04/29 10:02


工作中经常会用到的把几个Excel文件合并到一个,或者是把一个Excel文件里的所有Sheet合并到一个Sheet来进行统计。下面分别提供用vba宏来解决这两个问题的方法。

1、合并Excel文件

打开一个空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 Sub



这段代码的作用:它首先打开一个文件选择框,你可以选择一个或多个文件,然后把这些文件里的所有Sheet合并到当前这个工作簿里来,有重名的Sheet会自动在后面加数字。

2、合并一个EXCEL多个sheet的内容到一个汇总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 0End FunctionSub 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 "内容太多放不下啦!"                   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   NextExitSub:   Application.GoTo DestSh.Cells(1)   DestSh.Columns.AutoFit   Application.ScreenUpdating = True   Application.EnableEvents = TrueEnd Sub



这段代码的作用:它会新建一个叫做“汇总”的工作表,然后把当前工作簿里的所有Sheet里有数据的内容都复制到“汇总”表里。提示:如果数据表里的内容没有表头的话需要把StartRow = 2改成StartRow = 1



3.按需合并工作表

在EXCEL中打开宏,将下列代码进行粘贴并保存。然后返回你需要合并的工作表中,运行此宏,看看效果吧。

Sub 合并sheets()
n = 12 '源表个数,根据需要修改!
nstart = 9 '每个单表数据的开始行数,根据需要修改!
k = nstart '目标表的行标
For i = 1 To n
irow = nstart '行标
While Sheets(i).Cells(irow + 1, 2) <> "" '后面个1以第2列数据的最后1行是空作为行结束标示,确定源表的行数,根据需要修改!
irow = irow + 1
Wend
Sheets(i).Rows(nstart & ":" & irow).Copy '复制源数据行
Sheets(n + 1).Activate
Sheets(n + 1).Cells(k, 1).Select
ActiveSheet.Paste '粘贴数据
k = k + irow - nstart + 1
Next i
End Sub
1 0
原创粉丝点击