-
2017-07-20 20:33:48
合并sheet页, 合并excel文档, 合并工作表, 合并工作簿
合并工作表(sheet)
合并多个工作表
仅适用于每个sheet的第一行是数据头,数据从第二行开始。Sub 合并工作表() Dim J As Integer On Error Resume Next Sheets(1).Select Worksheets.Add Sheets(1).Name = "Combined" Sheets(2).Activate Range("A1").EntireRow.Select Selection.Copy Destination:=Sheets(1).Range("A1") For J = 2 To Sheets.Count Sheets(J).Activate c = Sheets(J).Range("IV1").End(xlToLeft).Column r = Sheets(J).Range("A65536").End(xlUp).Row Range("A2").Resize(r - 1, c).Select Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2) Next End Sub
合并工作簿
Sub 合并工作簿() Dim FileOpen Dim X As Integer Application.ScreenUpdating = False FileOpen = Application.GetOpenFilename(FileFilter:="Excel 97-2003 工作簿(*.xls),*xls,Microsoft Excel文件(*.xlsx),*.xlsx", MultiSelect:=True, Title:="请选择需要合并的工作簿") X = 1 If TypeName(FileOpen) = "Boolean" Then MsgBox "未选择任何文件, 退出." Exit Sub End If While X <= UBound(FileOpen) Workbooks.Open Filename:=FileOpen(X) Sheets().Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) X = X + 1 Wend ExitHandler: Application.ScreenUpdating = True Exit Sub errhadler: MsgBox Err.Description End Sub
更多相关内容 -
用VBA合并计算Excel多个工作簿及工作表
2021-12-05 11:44:53VBA - Excel多工作簿合并计算因为有人询问合并计算,对VBA略知一些,我就写了一点,有需要的人可以借鉴。
新建一个工作表,粘贴到模块,F5运行,就可以达到左列合计,左列为一列。
下面是代码:
无源数据格式
Sub 多工作簿合计() Application.ScreenUpdating = False Dim Wb As Workbook, vrtSelectedItem As Variant, Mysheet As Worksheet, CellAddress Dim ShRan As String, Arr() As String, s As Long, Spt, NewPath As String, Bool As Boolean On Error Resume Next '遇到错误继续执行 With Application.FileDialog(msoFileDialogFilePicker) .AllowMultiSelect = True '多选 .InitialFileName = ThisWorkbook.Path & "\" '默认路径 .Title = "选择文件" '窗口标题 .Filters.Clear '清除文件过滤器 .Filters.Add "全部文件", "*.*" .Filters.Add "Excel文件", "*.xlsm" .Filters.Add "Excel文件", "*.xls" .Filters.Add "Excel文件", "*.xlsx;*.xls" '设置文件过滤器,可以指定多个扩展名,每个扩展名都必须用分号分隔。 例如,可以将参数分配给字符串:".txt;.htm"。 Cells.Clear Bool = True If .Show = -1 Then For Each vrtSelectedItem In .SelectedItems Spt = Split(vrtSelectedItem, "\") NewPath = "'" & Replace(vrtSelectedItem, Spt(UBound(Spt)), "[" & Spt(UBound(Spt)) & "]") Set Wb = Workbooks.Open(vrtSelectedItem) For Each Mysheet In Wb.Worksheets '复制标题行,不带格式粘贴 If Bool Then Mysheet.Rows("1:1").Copy Cells(1, 1).PasteSpecial Paste:=xlPasteValues Bool = False Application.CutCopyMode = False End If ReDim Preserve Arr(s) '获取不包含首行的当前区域 CellAddress = Split(Mysheet.Cells(2, 1).CurrentRegion.Address, ":") ShRan = Mysheet.Name & "'!" & Mysheet.Range("A2:" & CellAddress(1)).Address(ReferenceStyle:=xlR1C1) '数据区域 Arr(s) = NewPath & ShRan s = s + 1 Next Mysheet Wb.Close Next vrtSelectedItem Set Wb = Nothing End If End With Range("A2").Consolidate Sources:=Arr, Function:=xlSum, TopRow:=False, LeftColumn:=True, CreateLinks:=False Application.ScreenUpdating = True End Sub
下面是有源数据格式的
Sub 汇总合计() '保留源数据格式 Application.ScreenUpdating = False Dim Wb As Workbook, vrtSelectedItem, Mysheet As Worksheet, i As Long, Bool As Boolean, Start_row 'On Error Resume Next '容错 With Application.FileDialog(msoFileDialogFilePicker) .AllowMultiSelect = True '多选 .InitialFileName = ThisWorkbook.Path & "\" '默认路径 .Title = "选择文件" '窗口标题 .Filters.Clear '清除文件过滤器 .Filters.Add "全部文件", "*.*" .Filters.Add "Excel文件", "*.xlsx;*.xls" '可以指定多个扩展名,每个扩展名都必须用分号分隔。 例如,可以将参数分配给字符串:".txt;.htm"。 .Filters.Add "Excel文件", "*.xlsm" .Filters.Add "Excel文件", "*.xls" '设置文件过滤器 Cells.Clear Bool = True If .Show = -1 Then For Each vrtSelectedItem In .SelectedItems Set Wb = Workbooks.Open(vrtSelectedItem) With ThisWorkbook.ActiveSheet For Each Mysheet In Wb.Worksheets If Bool = True Then Start_row = 1 Else Start_row = 2: Bool = False '获取不包含首行的当前区域 CellAddress = Split(Mysheet.Cells(1, 1).CurrentRegion.Address, ":") Mysheet.Range("A" & Start_row & ":" & CellAddress(1)).Copy .Cells(i + 1, 1) i = Mysheet.Range("A1").CurrentRegion.Rows.Count Next End With Wb.Close Next Set Wb = Nothing End If End With Dim RowCount As Long, MyRange As String, ColCount As Long, DataCol As Long, E_Coords, Act_sh With ThisWorkbook.ActiveSheet RowCount = .Cells(Rows.Count, 2).End(xlUp).Row ColCount = .Cells(1, 1).CurrentRegion.Columns.Count Act_sh = .Cells(1, 1).CurrentRegion.Address .Range(Act_sh).Copy With .Cells(1, ColCount + 1) .PasteSpecial Paste:=xlPasteColumnWidths .PasteSpecial Paste:=xlPasteFormats End With Application.CutCopyMode = False E_Coords = Split(Act_sh, ":")(1) MyRange = ActiveSheet.Name & "!" & .Range("A2:" & E_Coords).Address(ReferenceStyle:=xlR1C1) .Cells(2, ColCount + 1).Consolidate Sources:=MyRange, _ Function:=xlSum, TopRow:=False, LeftColumn:=True, CreateLinks:=False .Range("A2:" & E_Coords).Delete Shift:=xlToLeft .Range(Range("A1").CurrentRegion.Rows.Count + 1 & ":" & .Cells.Rows.Count).ClearFormats End With Application.ScreenUpdating = True End Sub
-
VBA学习笔记3:合并同一工作簿下的多个表格
2022-04-16 13:57:24VBA学习笔记3:合并同一工作簿下的多个表格VBA学习笔记3:合并同一工作簿下的多个表格
1、建立一个新的汇总表;
2、将其他sheet数据复制到汇总表中。效果如下:
需要将3个sheet的表的数据汇总起来
汇总后的数据:
代码如下:
Sub 合并多个工作表数据() Dim sht As Worksheet Dim rows%, hzrows% ’row存储被复制的sheet的行数,hzrow存储新建表的行数 ThisWorkbook.Worksheets().Add(before:=ThisWorkbook.Worksheets("1月")).Name = "汇总" 'worksheets.add.name="" 在1月sheet前创建工作表并重命名为“汇总” [a1] = "月份" [b1] = "姓名" [c1] = "成绩" For Each sht In Worksheets '循环 If sht.Name <> ActiveSheet.Name Then ‘除“汇总”外所有的表都要复制过来 rows = WorksheetFunction.CountA(sht.[a:a]) 'sheet中a列不为空的行数(注意a列不要有空值) hzrows = WorksheetFunction.CountA(ActiveSheet.[a:a]) '“汇总”中的行数(新建表“汇总”即activesheet,也可用worksheets("汇总")替代activesheet) sht.Range("a2:b" & rows).Copy ActiveSheet.Range("b" & hzrows + 1) ’将sht的a2及以后的数据复制,粘贴只“汇总”的b列的第一个空行 Range(Cells(hzrows + 1, 1), Cells(hzrows + rows - 1, 1)) = sht.Name '将sht的表名作为“汇总”的a列值 (从第一份非空行开始,到两个表非空行数-1) End If Next sht End Sub
也可以手工新建“汇总”表后插入按钮,效果如下:
Private Sub CommandButton1_Click() ActiveSheet.Range("1:1045876").ClearContents '清空工作簿 Dim sht As Worksheet Dim rows%, hzrows% [a1] = "月份" [b1] = "姓名" [c1] = "成绩" For Each sht In Worksheets If sht.Name <> ActiveSheet.Name Then rows = WorksheetFunction.CountA(sht.[a:a]) hzrows = WorksheetFunction.CountA(ActiveSheet.[a:a]) sht.Range("a2:b" & rows).Copy Range("b" & hzrows + 1) Range(Cells(hzrows + 1, 1), Cells(hzrows + rows - 1, 1)) = sht.Name End If Next sht End Sub
-
合并选定的多个Excel文件中的所有工作表到一个文件中(多个工作表)-工具
2017-06-29 07:56:27VBA代码,可以合并选定的多个Excel文件中的所有工作表到一个文件中(多个工作表) -
Excel实现所有工作表的内容合并到一个新的工作表.xlsm
2020-06-29 14:08:59将同一个工作簿中的所有工作表的内容合并到一个工作表中;新建一个汇总的工作表,并重新自定义命名;2、逐一将各个工作表复制粘贴到汇总工作表中;3、为提示,即当合并工作完成后弹出提示 -
Excel VBA小程序04- 合并同文件夹下多工作簿中同名工作表并生成汇总表格
2020-08-10 22:46:44参考: VBA 合并同文件夹下多工作簿中同名工作表到 一工作簿一工作表 2022/1/19 更新 跳过不含指定sheet的工作薄并汇总。 Sub Build_Sheet_List() Dim sht As Worksheet, i As Long, strName As String With Columns...参考:
VBA 合并同文件夹下多工作簿中同名工作表到 一工作簿一工作表2022/1/19 更新
跳过不含指定sheet的工作薄并汇总。Sub Build_Sheet_List() Dim sht As Worksheet, i As Long, strName As String With Columns(1) .Clear '清空A列数据 .NumberFormat = "@" '设置文本格式 End With For i = 1 To Sheets.Count '索引法遍历工作表集合 strName = Sheets(i).Name '表名 Cells(i, 1).Value = strName ActiveSheet.Hyperlinks.Add anchor:=Cells(i, 1), Address:="", _ SubAddress:="'" & strName & "'!a1", TextToDisplay:=strName Next End Sub Sub all_excel_files() Dim path As String, filename As String Dim w As Workbook, ws As Workbook With Application.FileDialog(msoFileDialogFolderPicker) '-------------------取得用户选择的文件夹路径--------------------------- If .Show Then path = .SelectedItems(1) Else Exit Sub End With If Right(path, 1) <> "\" Then path = path & "\" filename = Dir(path & "\*.xls*") Application.DisplayAlerts = False '-------------------取得用户选择的合并工作表名--------------------------- strKey = InputBox("请输入需要合并的工作表名:", "提醒") If StrPtr(strKey) = 0 Then Exit Sub '-----------打开指定文件夹下的工作薄,复制粘贴工作表到汇总表,重命名-------------------- Set ws = Workbooks.Add Do While filename <> "" 'w代表指定文件夹下每个找到的excel文件 Set w = Workbooks.Open(path & "\" & filename) '选择工作表,复制,并粘贴为汇总表的最后一张 If strKey = ActiveSheet.Name Then w.Sheets(strKey).Copy after:=ws.Sheets(ws.Sheets.Count) ' 重命名刚贴的表名为excel文件名 If Right(filename, 4) = "xls*" Then ws.Worksheets(ws.Sheets.Count).Name = Mid(filename, 1, Len(filename) - 4) Else ws.Worksheets(ws.Sheets.Count).Name = Mid(filename, 1, Len(filename) - 5) End If ' 关闭工作簿 w.Close '下一个 filename = Dir Loop '-----------制作目录工作表-------------------- Sheets("Sheet1").Name = "目录" Sheets("目录").Select Call Build_Sheet_List Application.DisplayAlerts = True ws.SaveAs path & "\汇总.xlsx" End Sub
将所汇总的数据逐个添加到同一工作表中见下载链接:
https://download.csdn.net/download/weixin_42750611/76744062
效果如下:
2020/8/10
在原先代码的基础上修改,可以自由选择和输入要合并多工作簿的同文件夹和工作表名,并生成目录页。
效果展示:
1、选择工作表2、输入指定相同工作表名
3、等待程序执行完毕。
代码如下:Sub Build_Sheet_List() Dim sht As Worksheet, i As Long, strName As String With Columns(1) .Clear '清空A列数据 .NumberFormat = "@" '设置文本格式 End With For i = 1 To Sheets.Count '索引法遍历工作表集合 strName = Sheets(i).Name '表名 Cells(i, 1).Value = strName ActiveSheet.Hyperlinks.Add anchor:=Cells(i, 1), Address:="", _ SubAddress:="'" & strName & "'!a1", TextToDisplay:=strName Next End Sub Sub all_excel_files() Dim path As String, filename As String Dim w As Workbook, ws As Workbook With Application.FileDialog(msoFileDialogFolderPicker) '-------------------取得用户选择的文件夹路径--------------------------- If .Show Then path = .SelectedItems(1) Else Exit Sub End With If Right(path, 1) <> "\" Then path = path & "\" filename = Dir(path & "\*.xls") Application.DisplayAlerts = False '-------------------取得用户选择的合并工作表名--------------------------- strKey = InputBox("请输入需要合并的工作表名:", "提醒") If StrPtr(strKey) = 0 Then Exit Sub '-----------打开指定文件夹下的工作薄,复制粘贴工作表到汇总表,重命名-------------------- Set ws = Workbooks.Add Do While filename <> "" 'w代表指定文件夹下每个找到的excel文件 Set w = Workbooks.Open(path & "\" & filename) '选择工作表,复制,并粘贴为汇总表的最后一张 If strKey <> ActiveSheet.Name Then w.Close If strKey <> ActiveSheet.Name Then MsgBox "该文件夹内存在不含指定工作表名的工作薄,请重新检查!", 64, "提示": Exit Sub w.Sheets(strKey).Copy after:=ws.Sheets(ws.Sheets.Count) '重命名刚贴的表名为excel文件名 If Right(filename, 4) = ".xls" Then ws.Worksheets(ws.Sheets.Count).Name = Mid(filename, 1, Len(filename) - 4) Else ws.Worksheets(ws.Sheets.Count).Name = Mid(filename, 1, Len(filename) - 5) '关闭工作簿 w.Close '下一个 filename = Dir Loop '-----------制作目录工作表-------------------- Sheets("Sheet1").Name = "目录" Sheets("目录").Select Call Build_Sheet_List Application.DisplayAlerts = True ws.SaveAs path & "\汇总.xlsx" End Sub
小提示:
1、如果只想打开文件夹内的xlsx文件filename = Dir(path & "\*.xls")
改为filename = Dir(path & "\*.xlsx*")
可以同时打开文件夹中的xls文件。 -
多个excel工作簿合并_如何使用Excel VBA将多个工作簿的全部工作表合并到一个工作簿中...
2020-11-18 11:26:21在一些操作中,往往会需要将多个工作簿进行合并。一般的操作方法都是打开两个工作簿,然后选中需要移动的工作表,右键单击以后选择“移动或复制”。接下来在新的窗口里面进行设置就可以了。这种方法适合在移动数量较... -
excel合并文件夹下所有excel文件到一个工作表中
2020-03-19 14:51:30excel中vba下的代码,合并当前文件夹下所有excel工作表到一个新建的工作表中,并将合并的数据进行横向铺开排列。 -
VBA多工作簿中多工作表分类汇总
2022-05-13 16:53:27将某一文件夹下所有工作簿中的多张表单汇总到一个工作薄中的一张表单中 最终效果: 步骤流程: 完整代码: ========================================================================= 1、汇总当前... -
VBA学习笔记4:将同一文件下的多个工作簿的数据汇总为一个工作表
2022-04-17 20:01:17将同一文件下的多个工作簿的数据汇总为一个工作表 -
VBA在多Excel工作薄数据汇总的应用
2021-04-18 09:45:43利用Excel进行数据处理分析时,常需要对大量独立的具有相同表结构的原始工作薄中的数据进行汇总合并到一个工作薄的指定工作表中。通过VBA编程调用Excel对象在不打开源工作薄的情况下,将指定文件夹中所有工作薄中的... -
用VBA实现把多个Excel文件合并到一个Excel文件的多个工作表(Sheet)里
2020-12-29 19:47:56应同事需要写了一段VBA代码,实现的功能是把多个Excel文件的第一个工作表(Sheet)合并到一个Excel文件的多个工作表里,并且新工作表的名称等于原Excel文件的文件名。开发环境Excel2010,但是Excel2003应该也能用,... -
多个excel工作簿合并_Excel用VBA代码一键合并汇总多个工作簿,省时省力必学!...
2020-11-18 11:26:21今天将大家用VBA一键合并,只需要几秒种,为了测试这段代码,我们新建了4个工作簿在文件夹中,数据都是模拟的,做试验一键合并代码操作如下所示:我们看原始表格数据,其中,第1个工作簿有点特殊,这个工作簿中,有... -
使用VBA汇总工作表
2022-05-03 21:24:06目的:将一张工作薄中的多张工作表中的数据记录汇总到一张表中,并统计数据记录条数 如下图所示,将下图中4张工作表中的数据汇总到“汇总表”中 代码实现: (1)该代码是微调宏录制的代码 Sub 核酸汇总() ... -
excel VBA自动化 - 多个工作簿自动合并到一个工作簿
2022-03-31 10:26:51多个excel表自动合并到同一表格,该段vba代码的逐句拆解 -
利用VBA实现多个Excel工作簿快速合并方法
2020-12-19 11:45:57双击打开汇总文件.xls(当然我们也可以随便新建一个excel文档),按ALT+F11打开VBE编辑器,新建一个模块,粘贴如下代码:Option ExplicitSub mergeonexls() '合并多工作簿中指定工作表On Error Resume NextDim x As ... -
ExcelVBA 将多张工作表中的数据合并到一张工作表中
2020-02-25 21:19:13在工作中,我们经常遇到多张工作表合并到一张工作表的问题,比如希望将图1所示中各分表中保存的成绩记录,汇总到工作簿中的"成绩表"工作表中,可以用图2下面的程序。 图1 七(3)班工作表中的成绩记录 图2汇总... -
VBA学习——对“快速将多个excel表合并成一个excel表”进行说明及优化
2021-07-05 10:51:48sub 合并当前目录下所有工作簿的全部工作表() dim mypath, myname, awbname dim wb as workbook, wbn as string '字符串类型 String; dim g as long '长整型 Long,占用4个字节; dim num as long dim b -
Excel·VBA合并工作簿中所有工作表
2022-03-29 22:36:05对Excel活动工作簿进行合并,汇总所有工作表,保存在工作簿最前,适用于同格式 合并工作簿中所有工作表 Sub 合并工作簿中所有工作表() '当前工作簿wb所有工作表ws合并保存至新建工作表(插入最前),但之前ws不修改... -
excel中使用VBA进行多工作簿或多工作表一键汇总
2021-01-20 16:26:161.同一目录下的多工作簿,每个工作簿中有一张或多张工作表,一键全部汇总 Sub 合并目录所有工作簿全部工作表() Dim MP, MN, AW, Wbn, wn Dim Wb As Workbook Dim i, a, b, d, c, e Application.ScreenUpdating... -
excel 宏把多个工作表合并成一个工作表
2019-09-01 16:20:38那其实也可以把多个工作表合并为一个。 继续之前的例子,我们把汇总表删除 如下 把表 1,2,3 合并到sheet5中 合并代码如下: Sub 合并当前工作簿下的所有工作表() Application.ScreenUpdating = Fals... -
利用VBA快速将多个工作簿中的sheet表数据合并到一个sheet表里
2020-12-29 02:36:08我们在实际工作中,有时候需要将多个工作薄中的sheet表的数据快速合并到一个sheet表里,假如我们使用手动去复制粘贴,这样就特别浪费时间和精力,所以我们可以使用VBA快速实现,我们只需要输入VBA代码。Sub 合并当前... -
vba实现excel多表合并
2020-12-22 11:06:10Excel多表合并之vba实现需求保留列名,复制每一个excel里的数据,合并到一个excel操作步骤将要合并的文件放在同一文件夹下,复制过来就好(ps:最好不要直接操作原数据文件,避免操作失败,数据丢失)在这个目录下创建... -
excel合并多个工作表_如何将多个Excel工作薄中工作表批量合并到一个工作薄
2020-11-18 11:40:49编辑:哈雷 |来源:巨盒创意 | 欢迎转发到朋友圈日常工作中,我们可能有这样的需求,我们的数据分别存放在N个工作簿里,我们需要把这些零散的数据都移动到一个工作簿里面,而且每张工作表分别存在!我们常用的方法是... -
vba宏如何快速的把多个excel表合并成一个excel表(便捷高效)
2020-11-03 15:56:05我们需要把多个excel表都放在同一个文件夹里面,并在这个文件夹里面新建...Sub 合并当前目录下所有工作簿的全部工作表() Dim MyPath, MyName, AWbName Dim Wb As Workbook, WbN As String Dim G As Long Dim Num As -
Excel如何用VBA代码一键合并汇总多个工作簿中的指定Sheet?
2021-09-29 22:18:59如何修改如下代码,可以精准指定合并...Dir Loop Range("a1").Select Application.ScreenUpdating = True MsgBox "共合并了" & a & "个工作薄下全部工作表。如下:" & Chr(13) & Wbn, vbInformation, "提示" End Sub -
Excel用VBA代码一键合并汇总多个工作簿,省时省力必学!
2020-12-19 11:45:56今天将大家用VBA一键合并,只需要几秒种,为了测试这段代码,我们新建了4个工作簿在文件夹中,数据都是模拟的,做试验一键合并代码操作如下所示:我们看原始表格数据,其中,第1个工作簿有点特殊,这个工作簿中,有... -
VBA代码实例---多个工作表内容合并到一个工作表中
2017-04-18 23:41:42这是一个常用而且经典的例子:根据内容,把N个工作表中的内容,合并到一个工作表中; ¤主要知识点¤ 1、工作表选取和内容的复制; 2、IF分支语句和For循环语句的使用; ¤代码实例¤ Option Explicit Sub ... -
多个工作簿,指定Sheet工作表数的据合并到一个新的Sheet页里面,求一个VBA代码?
2021-01-13 20:16:54每个工作簿里有多个工作表,需要将两个工作簿指定Sheet工作表(战力值排名)的数据合并在一个新工作簿的新Sheet页里面(新的Sheet页需命名为“数据汇总”); <p>2、新的Sheet... -
VBA 合并同文件夹下多工作簿中同名工作表到 一工作簿一工作表
2019-02-10 20:27:05批量合并excel工作簿中同名工作表,适用条件: 1、所有要汇总的工作簿在同一个文件夹中,这里以后缀为.xlsx为例; 2、需要合并的工作表名称相同(如: “sheet1”),且数据字段一样(如:A列表示序号,B列表示姓名,...