文档库 最新最全的文档下载
当前位置:文档库 › excel合并多个工作簿中的工作表

excel合并多个工作簿中的工作表

excel合并多个工作簿中的工作表
excel合并多个工作簿中的工作表

excel合并多个工作簿中的工作表

在同一文件夹中有多个工作簿,其中有一个用于汇总的工作簿,要求将除该汇总工作簿外的其它工作簿中的指定工作表的数据汇总到该汇总工作簿中。(这个最好用)代码如下:

Sub UnionWorksheets()

Application.ScreenUpdating = False

Dim lj As String

Dim dirname As String

Dim nm As String

lj = ActiveWorkbook.Path

nm = https://www.wendangku.net/doc/2218467699.html,

dirname = Dir(lj & "\*.xls*")

Cells.Clear

Do While dirname <> ""

If dirname <> nm Then

Workbooks.Open Filename:=lj & "\" & dirname

Workbooks(nm).Activate

'复制新打开工作簿的第一个工作表的已用区域到当前工作表

Workbooks(dirname).Sheets(1).UsedRange.Copy _

Range("A65536").End(xlUp).Offset(1, 0)

'sheets(1) 中的1为工作表顺序号

Workbooks(dirname).Close False

End If

dirname = Dir

Loop

End Sub

可以将指定目录下的excel工作簿中的指定表!汇总到一起!

例如!将book1.xlsx中的sheet1。

book2.xlsx中的sheet1。

book3.xlsx中的sheet1。

book4.xlsx中的sheet1。

~~~~~~~~~~

合并到book汇总.xlsx中的sheet1中

如果你的建议是复制~~粘贴~就算了!这个我知道如何使用!

如果提供宏的朋友可以加入详细说明,以便我学习,我将酌情加分!

谢谢!

最佳答案

Sub Macro1()

Dim lj$, dirname$, nm$, wb As Workbook, sh As Worksheet, a, b

Set wb = ThisWorkbook

a = Array(0, 2, 1)

b = Array(0, -1, 0)

lj = ThisWorkbook.Path

nm = https://www.wendangku.net/doc/2218467699.html,

dirname = Dir(lj & "\*.xls")

Application.ScreenUpdating = False

For Each sh In Sheets

https://www.wendangku.net/doc/2218467699.html,edRange.Offset(3, 0).Clear

Next

Do While dirname <> ""

If dirname <> nm Then

With GetObject(lj & "\" & dirname)

For i = 1 To 2

If IsSheetEmpty = IsEmpty(.Sheets(i).UsedRange) Then _

.Sheets(i).UsedRange.Offset(3, 0).Copy wb.Sheets(.Sheets(i).Name).Cells(65536, a(i)).End(xlUp).Offset(1, b(i))

Next

.Close False

End With

End If

dirname = Dir

Loop

Dim UserSheet As Worksheet

Set UserSheet = ActiveSheet

Dim TopRow As Long

Dim LeftCol As Integer

TopRow = ActiveWindow.ScrollRow

LeftCol = ActiveWindow.ScrollColumn

Dim LastRow As Long, R As Long

LastRow = https://www.wendangku.net/doc/2218467699.html,edRange.Rows.Count + https://www.wendangku.net/doc/2218467699.html,edRange.Row - 1

Application.ScreenUpdating = False

For R = LastRow To 1 Step -1

If WorksheetFunction.CountA(Rows(R)) = 0 Then Rows(R).Delete

End If

Next R

UserSheet.Activate

ActiveWindow.ScrollRow = TopRow

ActiveWindow.ScrollColumn = LeftCol

Application.ScreenUpdating = True

MsgBox "工作表合并已经完毕", "0", "提示"

End Sub

Sub 合并当前目录下所有工作簿的全部工作表()

Dim MyPath, MyName, AWbName

Dim Wb As Workbook, WbN As String

Dim G As Long

Dim Num As Long

Dim BOX As String

Application.ScreenUpdating = False

MyPath = ActiveWorkbook.Path

MyName = Dir(MyPath & "\" & "*.xls")

AWbName = https://www.wendangku.net/doc/2218467699.html,

Num = 0

Do While MyName <> ""

If MyName <> AWbName Then

Set Wb = Workbooks.Open(MyPath & "\" & MyName)

Num = Num + 1

With Workbooks(1).ActiveSheet

.Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)

For G = 1 To Sheets.Count

Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)

Next

WbN = WbN & Chr(13) & https://www.wendangku.net/doc/2218467699.html,

Wb.Close False

End With

End If

MyName = Dir

Loop

Range("B1").Select

Application.ScreenUpdating = True

MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下:" & Chr(13) & WbN, vbInformation, "提示"

End Sub

使用VBA合并多个Excel工作簿

例如,需要将多个Excel工作簿中的工作表合并到一个工作簿。这里假设需要合并的工作簿在“D:\示例\数据记录\”文件夹中,含有两个工作簿test1.xls、test2.xls(当然,可以不限于两个),在test1.xls工作簿中含有三张工作表,在test2.xls工作簿中含有两张工作表,现在使用一段VBA代码合并这两个工作簿到一个新工作簿中,合并到新工作簿中的工作表分别以原工作簿名加索引值命名。代码如下:

Sub CombineWorkbooks()

Dim strFileName As String

Dim wb As Workbook

Dim ws As Object

'包含工作簿的文件夹,可根据实际修改

Const strFileDir As String = "D:\示例\数据记录\"

Application.ScreenUpdating = False

Set wb = Workbooks.Add(xlWorksheet)

strFileName = Dir(strFileDir & "*.xls*")

Do While strFileName <> vbNullString

Dim wbOrig As Workbook

Set wbOrig = Workbooks.Open(Filename:=strFileDir & strFileName, ReadOnly:=True)

strFileName = Left(Left(strFileName, Len(strFileName) - 4), 29)

For Each ws In wbOrig.Sheets

ws.Copy After:=wb.Sheets(wb.Sheets.Count)

If wbOrig.Sheets.Count > 1 Then

wb.Sheets(wb.Sheets.Count).Name = strFileName & ws.Index

Else

wb.Sheets(wb.Sheets.Count).Name = strFileName

End If

Next

wbOrig.Close SaveChanges:=False

strFileName = Dir

Loop

Application.DisplayAlerts = False

wb.Sheets(1).Delete

Application.DisplayAlerts = True

Application.ScreenUpdating = True

Set wb = Nothing

End Sub

下面是合并多个Excel工作簿的另一种情形,也是《Excel VBA实战技巧精粹》中<技巧91:汇总多个工作簿的工作表>所介绍的方法,即合并汇总。

有四个工作簿,分别为:汇总工作簿.xls、一月.xls、二月.xls、三月.xls,其中一月.xls、二月.xls、三月.xls均只含有一张工作表且工作表中的数据均自单元格A1开始,现在要求将它们合并至“汇总工作簿.xls”中。

在“汇总工作簿.xls”中打开VBE,并输入下列代码:

Sub ConsolidateWorkbook()

Dim RangeArray() As String

Dim bk As Workbook

Dim sht As Worksheet

Dim WbCount As Integer

WbCount = Workbooks.Count

ReDim RangeArray(1 To WbCount - 1)

For Each bk In Workbooks '在所有工作簿中循环

If Not bk Is ThisWorkbook Then '非代码所在工作簿

Set sht = bk.Worksheets(1) '引用工作簿的第一个工作表

i = i + 1

RangeArray(i) = "'[" & https://www.wendangku.net/doc/2218467699.html, & "]" & https://www.wendangku.net/doc/2218467699.html, & "'!" & _

sht.Range("A1").CurrentRegion.Address(ReferenceStyle:=xlR1C1) End If

Next

Worksheets(1).Range("A1").Consolidate _

RangeArray, xlSum, True, True

End Sub

如何将多个Excel工作簿合并到一个新的工作表的发法

有多个独立的excel工作簿文件需要合并到一个新的工作簿中,保留原来excel工作簿中各个excel工作表名称和结构。如果量小,可以采用打开一个个复制的方法。若有100多份excel 文件要合并到一个excel工作簿,这样就需要用批量处理多个工作簿的合并(PS:不是工作表)。 1、将需要合并的excel工作簿文件放置在一个文件夹中。 2、在该文件夹中,新建立一个新的excel工作簿文件。 3、打开新建立的excel工作簿文件,将鼠标移动到下方工作表名称sheet1上右键,选择查看代码。 4、在弹出的代码编辑窗口中,输入代码。 5、在代码窗口中,粘贴下列代码: Sub 合并当前目录下所有工作簿的全部工作表() Dim MyPath, MyName, AWbName Dim Wb As Workbook, WbN As String Dim G As Long Dim Num As Long Dim BOX As String Application.ScreenUpdating = False MyPath = ActiveWorkbook.Path MyName = Dir(MyPath &"\"&"*.xls") AWbName = https://www.wendangku.net/doc/2218467699.html, Num = 0 Do While MyName <>"" If MyName <> AWbName Then Set Wb = Workbooks.Open(MyPath &"\"& MyName) Num = Num + 1 With Workbooks(1).ActiveSheet .Cells(.Range("A65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4) For G = 1 To Sheets.Count Wb.Sheets(G).UsedRange.Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1) Next WbN = WbN & Chr(13) & https://www.wendangku.net/doc/2218467699.html, Wb.Close False End With End If MyName = Dir Loop Range("A1").Select Application.ScreenUpdating = True MsgBox "共合并了"& Num &"个工作薄下的全部工作表。如下:"& Chr(13) & WbN, vbInformation, "提示" End Sub

如何将多个Excel工作簿合并成一个新的工作簿

如何将多个E x c e l工作簿合并成一个新的工作 簿 集团公司文件内部编码:(TTT-UUTT-MMYB-URTTY-ITTLTY-

如何将多个Excel工作簿合并成一个新的工作簿 有多个独立的excel工作簿文件需要合并到一个新的工作簿中,保留原来excel工作簿中各个excel工作表名称和结构。如果量小,可以采用打开一个个复制的方法。若有100多份excel文件要合并到一个excel工作簿,这样就需要用批量处理多个工作簿的合并(PS:不是工作表)。 1、将需要合并的excel工作簿文件放置在一个文件夹中。 2、在该文件夹中,新建立一个新的excel工作簿文件。 3、打开新建立的excel工作簿文件,将鼠标移动到下方工作表名称sheet1上右键,选择查看代码。 4、在弹出的代码编辑窗口中,输入代码。 5、在代码窗口中,粘贴下列代码: Sub合并工作薄() DimFilesToOpen DimxAsInteger OnErrorGoToErrHandler Application.ScreenUpdating=False FilesToOpen=Application.GetOpenFilename_ (FileFilter:="MicroSoftExcel文件(*.xls),*.xls",_ MultiSelect:=True,Title:="要合并的文件") IfTypeName(FilesToOpen)="Boolean"Then MsgBox"没有选中文件"

GoToExitHandler EndIf x=1 Whilex<=UBound(FilesToOpen) Workbooks.OpenFilename:=FilesToOpen(x) x=x+1 Wend ExitHandler: Application.ScreenUpdating=True ExitSub ErrHandler: MsgBoxErr.Description ResumeExitHandler EndSub 6、点击菜单栏运行-运行子过程-用户窗体。关闭代码输入窗口。打开excel工作簿,可以看到下方已经将之前工作簿中的工作表都复制到了这一新建工作簿中。

excel合并工作簿和工作表的代码

把多个工作簿合并到一个工作簿作为新工作簿的一张表(宏代码) Sub 合并当前目录下所有工作簿的全部工作表() Dim MyPath, MyName, AWbName Dim Wb As Workbook, WbN As String Dim G As Long Dim Num As Long Dim BOX As String Application.ScreenUpdating = False MyPath = ActiveWorkbook.Path MyName = Dir(MyPath & "\" & "*.xls") AWbName = https://www.wendangku.net/doc/2218467699.html, Num = 0 Do While MyName <> "" If MyName <> AWbName Then Set Wb = Workbooks.Open(MyPath & "\" & MyName) Num = Num + 1 With Workbooks(1).ActiveSheet .Cells(.Range("A65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4) For G = 1 To Sheets.Count Wb.Sheets(G).UsedRange.Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1) Next WbN = WbN & Chr(13) & https://www.wendangku.net/doc/2218467699.html, Wb.Close False End With End If MyName = Dir Loop Range("A1").Select Application.ScreenUpdating = True MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下:" & Chr(13) & WbN, vbInformation, "提示" End Sub 具体操作:在工作簿目录下新建一工作簿,工具---宏----编辑器----插入—模块---粘贴代码==运行 excel如何将一个工作簿中的多个工作表合并到一张工作表上 打开你的工作簿新建一个工作表在这个工作表的标签上右键查看代码你把下面的代码复制到里边去,然后上面有个运行运行子程序就可以了,代码如下,如果出现问题你可以尝试工具宏宏安全性里把那个降低为中或者低再试试 Sub 合并当前工作簿下的所有工作表() Application.ScreenUpdating = False

【实务操作Excel】跨表、跨工作簿合并之合并多个工作表

多个工作表的合并及动态更新 之利用Excel数据新建查询(Power Query)功能 当今信息化“大数据”时代,数据汇总分析已经成为财务、税务、审计人员必不可少的一项技能。作为一线审计人员,经常与数据打交道,小编更是有切身体会,各种Excel函数、并表、透视等更是家常便饭手到擒来的事情。Excel操作技能慢慢成为每一个财税人员的看家本领,基础技能,小编后续在解码财税政策实务原理的同时,将会在【工具】菜单选项模块更新一系列Excel操作小技巧,相信能够给财税工作领域的小伙伴们带来实务工作上的便利,为您的职业发展助一臂之力。今天小编打算写一篇关于跨表或跨工作簿甚至跨文件夹合并的问题,这项“神技能”可以说是财税人员很少去运用的技能,但一旦掌握,您将受益终身。更多工具搜索:爱问财税

一、跨表合并解决的问题 财务部门作为公司数据记录、归集、处理中心,是企业管理运营的核心,成本费用的列支、收入现金的记录,采购端的支出、销售端的收入,公司合并、分立、上市、清算…等等,每项业务都需要在财务、税务部门体现出来。当公司规模不大时,可以手工简单处理,靠单笔查询或脑袋记忆就能解决,但一旦公司规模扩张,尤其多元化业务发展,企业的财务或税务人员势必面临着数据归集、处理、分析的难题。 今天所讲的跨表合并主要解决财务部门在面临不同部门提交的数据、不同日期、月份、年度的数据,或者不同公司、行业的报表数据等,各项数据分散在不同的工作表、工作簿甚至文件夹中,这种情况该如何解决入如何能运用Excel的操作技巧达到快速合并的效果,可以留给更多分析、报告的时间。 二、跨表合并解决的方法 跨表合并解决的方法其实有很多种,包括数据新建查询(Power Query)、方方格子、Excel易用宝、慧办公软件、VBA函数等,那么作为财税人员,我们应该学习哪种技能既能解决问题又比较容易上手呢?那么我们先分析下这些工具具体应用场景:

excel如何合并多个工作簿中的指定工作表

excel如何合并多个工作簿中的指定工作表 浏览次数:1256次悬赏分:30|解决时间:2010-4-14 02:10 |提问者:lanxue88888 每天要汇总很多数据! 浪费太多时间! 现在求一个宏,或者工具! 可以将指定目录下的excel工作簿中的指定表!汇总到一起! 例如!将book1.xlsx中的sheet1。 book2.xlsx中的sheet1。 book3.xlsx中的sheet1。 book4.xlsx中的sheet1。 ~~~~~~~~~~ 合并到book汇总.xlsx中的sheet1中 如果你的建议是复制~~粘贴~就算了!这个我知道如何使用! 如果提供宏的朋友可以加入详细说明,以便我学习,我将酌情加分! 谢谢! 最佳答案 Sub Macro1() Dim lj$, dirname$, nm$, wb As Workbook, sh As Worksheet, a, b Set wb = ThisWorkbook a = Array(0, 2, 1) b = Array(0, -1, 0) lj = ThisWorkbook.Path nm = https://www.wendangku.net/doc/2218467699.html, dirname = Dir(lj & "\*.xls") Application.ScreenUpdating = False For Each sh In Sheets https://www.wendangku.net/doc/2218467699.html,edRange.Offset(3, 0).Clear Next Do While dirname <> "" If dirname <> nm Then With GetObject(lj & "\" & dirname) For i = 1 To 2 If IsSheetEmpty = IsEmpty(.Sheets(i).UsedRange) Then _ .Sheets(i).UsedRange.Offset(3, 0).Copy wb.Sheets(.Sheets(i).Name).Cells(65536, a(i)).End(xlUp).Offset(1, b(i)) Next .Close False End With End If

多个Excel表合并形成一个Excel中的多sheet工作簿

多个Excel表合并形成一个Excel中的多sheet工作簿 (2013-03-21 11:05:24) 转载▼ 分类:excel使用技巧 新建一个excel表(把所有表最终要导入的表)。在该表中按ALT+F11打开宏,插入------ 模块 在打开的窗口中输入: Sub CombineWorkbooks() Dim FilesToOpen Dim x As Integer On Error GoTo ErrHandler Application.ScreenUpdating = False FilesToOpen = Application.GetOpenFilename _ (FileFilter:="MicroSoft Excel文件(*.xls),*.xls", _ MultiSelect:=True, Title:="要合并的文件") If TypeName(FilesToOpen) = "Boolean" Then MsgBox "没有选中文件" GoTo ExitHandler End If x = 1 While x <= UBound(FilesToOpen) Workbooks.Open Filename:=FilesToOpen(x) Sheets().Move after:=ThisWorkbook.Sheets _ (ThisWorkbook.Sheets.Count) x = x + 1 Wend ExitHandler: Application.ScreenUpdating = True

Exit Sub ErrHandler: MsgBox Err.Description Resume ExitHandler End Sub 按F5运行宏。

快速合并单个excel表中的多个sheet的工作页

快速合并单个excel表中的多个Sheet的工作页 很多朋友会遇到这样的问题,就是很有很多页的数据,少的有几十页, 多的可能有几百页,然后需要合并到一个页面做数据分析,如果一页页的复 制粘贴的话,就比较麻烦.下面我就介绍一种利用excel的宏计算来解决这个问题. 2. 看到这么多数据页要合并,如果是复制粘贴的话,工作量就很大了 我们现在开始合并,首先要在最前页新建一个工作表。如图:

3. 在新建的Sheet表中右键”,找到查看代码”,然后看到宏计算界面如图所示:

4。看到宏计算界面,我们就只需要把下面的代码复制进去,代码如下,效果如下: Sub合并当前工作簿下的所有工作表() APPliCati On 。Scree nUpdati ng = False FOr j = 1 To SheetS.Cou nt If SheetS(j)。Name <〉 https://www.wendangku.net/doc/2218467699.html, The n X = Ran ge(”A65536")。E nd(xlUp )。Row + 1 SheetS(j)。UsedRa nge.Copy Cells(X, 1) End If NeXt Ran ge(”B1”)。Select APPIiCati on .Scree nUpdat ing = TrUe MSgBOX "当前工作簿下的全部工作表已经合并完毕!”, VbInformation,”提

示"

End Sub 5. 做完上面的事情,然后只需要点击工具栏上面的 运行”下的运行子过 程/用户窗体”就可以了,合并完之后会有提示。 提示完成之后就可以把宏计 算界面关闭了。如图所示: 6. 合并后的效果如下图,我们看到的是合并之后有 8000多行,就是205 页合并后的结果。谢谢.如有疑问,请留言。 Γ? Viπn*f? Iιc?l - ■曲和ill 仙 ¢1 SlhHl ∣? 丁 峙申 帕為*1■兢 φ?c φ Jba-I ll Ldj ΦM ?∏ SEi I iL Of 肝聲 初 5W ∣?(? g Q r ??! g a?c g g s??*?ιra ≤^**tioι *1β?fit) SbtU D1 邮IL w?, f ?4?l? ? F?lιt Ha SJkl ?JrAafklTt F?l" 金并由射工斥簿孑俪!?工作壽0 Mpl :”“加 S?τ∣∣t?l?4i i t ∣.ι? ≡ F?l>t f*r ; ≡ I T≠ S?*t*? C?sβt If $>*#ti.1j) Mi*? O A?Λ∣**5??il T?Λ* H ^ ∣?w<■厂 M?$??) 8M?l?) + 1 ≤‰t?t i 5 (j) Us?dOt?Ij(*. C*P7 Cillx-Q ri 1) EM If ?*K? ?fe n<*i *)S*Uc? A>∣kl Lf k? ∣i Φ? ~ ■9?L ■二 ______ _____ ____ ___ _____ 一 Ehi 沁 I 1 U 0也 S<τ**bl?Jk?LM 1 TrVt T Jeuv>TSTr?Iff ?H??ι ? VHR 伽?山忤 审亍 ? ir?.^ - ?j?rt ∣ : Bif iTΓ,?I*) ?4kllM4li44 J JP **∣ ?4?ι ∣?E 1 Tr ?■ 5 讥“酋角■=丘;斗? W * v≡.r! 1r-≡ r Γf :- KM Mi It fλvvl≡? ■?■* ?≠Uv^i?MR ? TvM I ■ ??-?J I M?M J > CFitik 1' ?+4∣llU ∣ uτf U L HW C SiH : ?Γ?C?歸 Q);汨£1 IM ∣.■:材艸乎世 t^?W *屮 £? ■ t T?? 5?iτ 0=七 Shvvtl Tbri4ΛiL*vt I TL ∣?l*?u i l* G1 ? F ?1 τ 4 Σ???tl(M sb*?tio? Slhtt i C Ioe ??■)■ )?:?: 斟 越聲二 *tB6O C

excel合并多个工作簿中的工作表

excel合并多个工作簿中的工作表 在同一文件夹中有多个工作簿,其中有一个用于汇总的工作簿,要求将除该汇总工作簿外的其它工作簿中的指定工作表的数据汇总到该汇总工作簿中。(这个最好用)代码如下: Sub UnionWorksheets() Application.ScreenUpdating = False Dim lj As String Dim dirname As String Dim nm As String lj = ActiveWorkbook.Path nm = https://www.wendangku.net/doc/2218467699.html, dirname = Dir(lj & "\*.xls*") Cells.Clear Do While dirname <> "" If dirname <> nm Then Workbooks.Open Filename:=lj & "\" & dirname Workbooks(nm).Activate '复制新打开工作簿的第一个工作表的已用区域到当前工作表 Workbooks(dirname).Sheets(1).UsedRange.Copy _ Range("A65536").End(xlUp).Offset(1, 0) 'sheets(1) 中的1为工作表顺序号 Workbooks(dirname).Close False End If dirname = Dir Loop End Sub

可以将指定目录下的excel工作簿中的指定表!汇总到一起! 例如!将book1.xlsx中的sheet1。 book2.xlsx中的sheet1。 book3.xlsx中的sheet1。 book4.xlsx中的sheet1。 ~~~~~~~~~~ 合并到book汇总.xlsx中的sheet1中 如果你的建议是复制~~粘贴~就算了!这个我知道如何使用! 如果提供宏的朋友可以加入详细说明,以便我学习,我将酌情加分! 谢谢! 最佳答案 Sub Macro1() Dim lj$, dirname$, nm$, wb As Workbook, sh As Worksheet, a, b Set wb = ThisWorkbook a = Array(0, 2, 1) b = Array(0, -1, 0) lj = ThisWorkbook.Path nm = https://www.wendangku.net/doc/2218467699.html, dirname = Dir(lj & "\*.xls") Application.ScreenUpdating = False For Each sh In Sheets https://www.wendangku.net/doc/2218467699.html,edRange.Offset(3, 0).Clear Next Do While dirname <> "" If dirname <> nm Then With GetObject(lj & "\" & dirname) For i = 1 To 2 If IsSheetEmpty = IsEmpty(.Sheets(i).UsedRange) Then _ .Sheets(i).UsedRange.Offset(3, 0).Copy wb.Sheets(.Sheets(i).Name).Cells(65536, a(i)).End(xlUp).Offset(1, b(i)) Next .Close False End With End If dirname = Dir Loop Dim UserSheet As Worksheet Set UserSheet = ActiveSheet

EXCEL合并多个工作薄中的相同指定工作表到另一个工作薄中

EXCEL合并多个工作薄中的相同指定工作表到另一个工作薄中文件夹下有600多个工作薄,每个工作薄中有工作表20多个,每个工作薄中都有一个工作表标签为"明细"的工作表,需要将名称为"明细"的指定工作表的数据,汇集罗列到另外一个工作薄的"汇总表"中,如何写vba代码 最佳答案 Sub 合并选定工作簿的第一个工作表() '功能:合并某文件下所有Excel工作簿中的第一个工作表 '使用:将要合并的工作簿拷贝到某文件夹下,新建一个工作簿后执行该宏 Dim WBName As String '汇总工作簿名称 Dim WBCurrent As String '当前正在合并的工作簿 Dim i As Integer Dim FileToOpen As Variant '选定的文件列表 '显示选择文件对话框,使用Ctrl或Shief键选取多个工作簿 FileToOpen = Application _ .GetOpenFilename("Excel Files (*.xls), *.xls", , "请选择要合并的工作簿", , True) '如果没有选择文件则退出 If IsArray(FileToOpen) = 0 Then MsgBox "没有选择文件" Exit Sub End If '不显示合并的过程 = False WBName = '逐个合并工作簿 For i = 1 To UBound(FileToOpen) '打开一个工作簿 Filename:=FileToOpen(i) WBCurrent = '将该工作簿复制到汇总工作簿 Sheets("明细").Copy Before:=Workbooks(WBName).Sheets(1) '将去掉".xls"后缀的工作簿文件名作为工作表名称, = Left(WBCurrent, Len(WBCurrent) - 4) '合并后关闭该工作簿 Workbooks(WBCurrent).Close Next i = True End Sub

同一EXCEL文件合并多个工作表数据到同一工作表

同一EXCEL文件合并多个工作表数据到同一工作 表 首先,添加通用函数 1.打开VBE。 2.单击“插入——模块”,添加一个新模块。 3.在模块窗口,输入下面的代码。 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 Function LastCol(sh As Worksheet) On Error Resume Next LastCol = sh.Cells.Find(what:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Column On Error GoTo 0 End Function 这两个函数分别用于查找工作表中包含数据的最后一行和最后一列。 下面,我们将复制工作簿中所有工作表的数据,并将这些数据合并到一个汇总工作表中。

复制多个工作表中的所有数据 1. 在模块窗口输入下列代码后,运行即可。 Sub合并工作表() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long Dim CopyRng As Range With Application .ScreenUpdating = False .EnableEvents = False End With '如果工作表"RDBMergeSheet"存在则将其删除 Application.DisplayAlerts = False On Error Resume Next ActiveWorkbook.Worksheets("RDBMergeSheet").Delete On Error GoTo 0 Application.DisplayAlerts = True '添加一个名为"RDBMergeSheet"的工作表 Set DestSh = ActiveWorkbook.Worksheets.Add https://www.wendangku.net/doc/2218467699.html, = "RDBMergeSheet" '遍历所有工作表并将数据复制到DestSh For Each sh In ActiveWorkbook.Worksheets If https://www.wendangku.net/doc/2218467699.html, <> https://www.wendangku.net/doc/2218467699.html, Then '找到在工作表DestSh中带有数据的最后一行 Last = LastRow(DestSh) '设置希望复制的单元格区域 Set CopyRng=https://www.wendangku.net/doc/2218467699.html,edRange '测试工作表DestSh中是否有足够的行用来复制所有数据

如何将多个Excel工作簿合并到一个新的工作簿的方法

如何将多个Excel工作簿合并成一个新的工作簿 有多个独立的excel工作簿文件需要合并到一个新的工作簿中,保留原来excel工作簿中各个excel工作表名称和结构。如果量小,可以采用打开一个个复制的方法。若有100多份excel 文件要合并到一个excel工作簿,这样就需要用批量处理多个工作簿的合并(PS:不是工作表)。 1、将需要合并的excel工作簿文件放置在一个文件夹中。 2、在该文件夹中,新建立一个新的excel工作簿文件。 3、打开新建立的excel工作簿文件,将鼠标移动到下方工作表名称sheet1上右键,选择查看代码。 4、在弹出的代码编辑窗口中,输入代码。 5、在代码窗口中,粘贴下列代码: Sub 合并工作薄() Dim FilesToOpen Dim x As Integer On Error GoTo ErrHandler Application.ScreenUpdating = False FilesToOpen = Application.GetOpenFilename _ (FileFilter:="MicroSoft Excel文件(*.xls), *.xls", _ MultiSelect:=True, Title:="要合并的文件") If TypeName(FilesToOpen) = "Boolean" Then MsgBox "没有选中文件" GoTo ExitHandler End If x = 1 While x <= UBound(FilesToOpen) Workbooks.Open Filename:=FilesToOpen(x) Sheets().Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) x = x + 1 Wend ExitHandler: Application.ScreenUpdating = True Exit Sub ErrHandler: MsgBox Err.Description Resume ExitHandler End Sub 6、点击菜单栏运行-运行子过程-用户窗体。关闭代码输入窗口。打开excel工作簿,可以看到下方已经将之前工作簿中的工作表都复制到了这一新建工作簿中。

EXCEL2007多工作簿合并,附详细操作步骤

Sub 合并当前目录下所有工作簿的全部工作表() Dim MyPath, MyName, AWbName Dim Wb As Workbook, WbN As String Dim G As Long Dim Num As Long Dim BOX As String Application.ScreenUpdating = False MyPath = ActiveWorkbook.Path MyName = Dir(MyPath & "\" & "*.xls") AWbName = https://www.wendangku.net/doc/2218467699.html, Num = 0 Do While MyName <> "" If MyName <> AWbName Then Set Wb = Workbooks.Open(MyPath & "\" & MyName) Num = Num + 1 With Workbooks(1).ActiveSheet .Cells(.Range("A65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4) For G = 1 To Sheets.Count Wb.Sheets(G).UsedRange.Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1) Next WbN = WbN & Chr(13) & https://www.wendangku.net/doc/2218467699.html, Wb.Close False End With End If MyName = Dir Loop Range("A1").Select Application.ScreenUpdating = True MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下:" & Chr(13) & WbN, vbInformation, "提示" End Sub 操作步骤: 1、新建一个文件夹,把需要合并的表格都放到新建的文件夹内 2、在新建文件夹内新建一个EXCEL表格 3、打开新建的EXCEL空表格,按ALT+F11,选择“插入-模块”如图:

快速合并单个excel表中的多个sheet的工作页

快速合并单个excel表中的多个sheet的工作页 很多朋友会遇到这样的问题,就是很有很多页的数据,少的有几十页,多的可能有几百页,然后需要合并到一个页面做数据分析,如果一页页的复制粘贴的话,就比较麻烦。下面我就介绍一种利用excel的宏计算来解决这个问题。 方法: 1. 首先我们要有自己的excel数据,并且我们需要的是microsoft excel, WPS没有这些负责的功能。比如我下面举例的,我自己有205页的数据需要合并,如图所示。 2. 看到这么多数据页要合并,如果是复制粘贴的话,工作量就很大了。 我们现在开始合并,首先要在最前页新建一个工作表。如图:

3. 在新建的sheet表中“右键”,找到“查看代码”,然后看到宏计算界面。 如图所示:

4. 看到宏计算界面,我们就只需要把下面的代码复制进去,代码如下, 效果如下: Sub 合并当前工作簿下的所有工作表() Application.ScreenUpdating = False For j = 1 To Sheets.Count If Sheets(j).Name <> https://www.wendangku.net/doc/2218467699.html, Then X = Range("A65536").End(xlUp).Row + 1 Sheets(j).UsedRange.Copy Cells(X, 1) End If Next Range("B1").Select Application.ScreenUpdating = True MsgBox "当前工作簿下的全部工作表已经合并完毕!", vbInformation, "提示"

批量将多个excel中的多个工作簿合并到一个excel中

批量将多个excel中的多个工作簿合并到一个excel中(2011-01-28 13:33:46)转载▼ 标签:杂谈 将要合并的excel放到一个文件夹中,在这个目录中新建一个excel。 打开新建的excel。 按alt+F11. 插入一个模块。 将下面的东东复制进去。 点击运行。 搞定。 Sub CombineFiles() Dim path As String Dim FileName As String Dim LastCell As Range Dim Wkb As Workbook Dim WS As Worksheet Dim ThisWB As String Dim MyDir As String MyDir = ThisWorkbook.path & "\" 'ChDrive Left(MyDir, 1) 'find all the excel files 'ChDir MyDir 'Match = Dir$("") ThisWB = https://www.wendangku.net/doc/2218467699.html, Application.EnableEvents = False Application.ScreenUpdating = False path = MyDir FileName = Dir(path & "\*.xls", vbNormal) Do Until FileName = "" If FileName <> ThisWB Then Set Wkb = Workbooks.Open(FileName:=path & "\" & FileName) For Each WS In Wkb.Worksheets Set LastCell = WS.Cells.SpecialCells(xlCellTypeLastCell) If LastCell.Value = "" And LastCell.Address = Range("$A$1").Address Then Else WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) End If Next WS Wkb.Close False End If

EXCEL中如何将多个工作表的内容合并到一个表格中

操作步骤: 1、原始数据所在工作簿包含多个格式相同的工作表,只不过每个工作表内容不同,比如说不同人名的工作表数据或者不同部门填写的数据。 2、在原始数据同目录下新建一个工作簿,建立两个工作表,名称分别为“首页”和“合并汇总表”。

3、按Alt+F11进入VBA代码编辑和调试界面。 # 4、根据下图提示,插入一个模块。

5、将下述代码粘贴到模块空白处: 复制代码 代码如下: Sub CombineSheetsCells() Dim wsNewWorksheet As Worksheet Dim cel As Range

Dim DataSource, RowTitle, ColumnTitle, SourceDataRows, SourceDataColumns As Var iant Dim TitleRow, TitleColumn As Range Dim Num As Integer Dim DataRows As Long DataRows = 1 Dim TitleArr() Dim Choice Dim MyName$, MyFileName$, ActiveSheetName$, AddressAll$, AddressRow$, AddressCo lumn$, FileDir$, DataSheet$, myDelimiter$ Dim n, i n = 1 i = 1 = False Worksheets("合并汇总表").Delete Set wsNewWorksheet = (, after:=Worksheets) = "合并汇总表" MyFileName = ("Excel工作薄 (*.xls*),*.xls*") If MyFileName = "False" Then MsgBox "没有选择文件!请重新选择一个被合并文件!", vbInformation, "取消" Else Filename:=MyFileName

如何将多个Excel工作簿合并成一个新的工作簿教学提纲

学习资料 如何将多个Excel工作簿合并成一个新的工作簿 有多个独立的excel工作簿文件需要合并到一个新的工作簿中,保留原来excel工作簿中各个excel工作表名称和结构。如果量小,可以采用打开一个个复制的方法。若有100多份excel 文件要合并到一个excel工作簿,这样就需要用批量处理多个工作簿的合并(PS:不是工作表)。 1、将需要合并的excel工作簿文件放置在一个文件夹中。 2、在该文件夹中,新建立一个新的excel工作簿文件。 3、打开新建立的excel工作簿文件,将鼠标移动到下方工作表名称sheet1上右键,选择查看代码。 4、在弹出的代码编辑窗口中,输入代码。 5、在代码窗口中,粘贴下列代码: Sub 合并工作薄() Dim FilesToOpen Dim x As Integer On Error GoTo ErrHandler Application.ScreenUpdating = False FilesToOpen = Application.GetOpenFilename _ (FileFilter:="MicroSoft Excel文件(*.xls), *.xls", _ MultiSelect:=True, Title:="要合并的文件") If TypeName(FilesToOpen) = "Boolean" Then MsgBox "没有选中文件" GoTo ExitHandler End If x = 1 While x <= UBound(FilesToOpen) Workbooks.Open Filename:=FilesToOpen(x) Sheets().Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) x = x + 1 Wend ExitHandler: Application.ScreenUpdating = True Exit Sub ErrHandler: MsgBox Err.Description 仅供学习与参考

excel怎么合并多个工作薄

excel怎么合并多个工作薄 excel合并工作薄的步骤: 将需要合并的excel工作簿文件放置在一个文件夹中。 每个文件夹中的工作簿都输入了简单的内容。 在该文件夹中,新建立一个新的excel工作簿文件。重命名为8. 在弹出的代码编辑窗口中,输入代码。注意:通过快捷键 Alt+F11打开的窗口如下没有直接复制代码的面板,需要点击左上 方的工程-VBAproject模块,双击sheet1,即可打开代码窗口。而 步骤3中的第二种方法可以直接打开代码输入窗口。 在代码窗口中,黏贴下列代码: SubCombineFiles() DimpathAsString DimFileNameAsString DimLastCellAsRange DimWkbAsWorkbook DimWSAsWorksheet DimThisWBAsString DimMyDirAsString MyDir=ThisWorkbook.path&"\" 'ChDriveLeft(MyDir,1)'findalltheexcelfiles 'ChDirMyDir 'Match=Dir$("")

ThisWB=https://www.wendangku.net/doc/2218467699.html, Application.EnableEvents=False Application.ScreenUpdating=False path=MyDir FileName=Dir(path&"\*.xls",vbNormal) DoUntilFileName="" IfFileName<>ThisWBThen SetWkb=Workbooks.Open(FileName:=path&"\"&FileName) ForEachWSInWkb.Worksheets SetLastCell=WS.Cells.SpecialCells(xlCellTypeLastCell) IfLastCell.Value=""AndLastCell.Address=Range("$A$1").Add ressThen Else WS.CopyAfter:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Co unt) EndIf NextWS Wkb.CloseFalse EndIf FileName=Dir() Loop Application.EnableEvents=True Application.ScreenUpdating=True

多个excel文件合并成一个文件

多个excel文件合并成一个文件 1、新建一个文件夹。 2、将要合并的表格放到里面 3、新建一个表格,用excel打开,右击Sheet1选择查看代码。 4、将下列代码复制到文本框中,点击运行,即可成功合并 Sub 合并当前目录下所有工作簿的全部工作表() Dim MyPath, MyName, AWbName Dim Wb As workbook, WbN As String Dim G As Long Dim Num As Long Dim BOX As String Application.ScreenUpdating = False MyPath = ActiveWorkbook.Path MyName = Dir(MyPath & "\" & "*.xls") AWbName = https://www.wendangku.net/doc/2218467699.html, Num = 0 Do While MyName <> "" If MyName <> AWbName Then Set Wb = Workbooks.Open(MyPath & "\" & MyName) Num = Num + 1 With Workbooks(1).ActiveSheet .Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4) For G = 1 To Sheets.Count Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1) Next WbN = WbN & Chr(13) & https://www.wendangku.net/doc/2218467699.html, Wb.Close False End With End If MyName = Dir Loop Range("B1").Select Application.ScreenUpdating = True MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下:" & Chr(13) & WbN, vbInformation, "提示" End Sub

相关文档
相关文档 最新文档