使用VBA拆分与合并工作表
使用VBA拆分与合并工作表
我们在实际工作中，经常会遇到将一个工作表按照某个特定字段拆分为N个工作簿，或者将N个工作簿合并为一个工作表，以下为使用VBA进行拆分和合并的源码。
Sub 拆分()
On Error Resume Next
Dim Recount As Long, hs As Long
Dim DataSheet As Worksheet
Dim sh As Worksheet
Dim Tx As String, mbwj As String, mbgzb As String, fll As String, bth As Integer, x As Integer, oldnum, newnum, ce, nx, dqxh
If Cells(2, 2) <> "" Then
mbwj = Cells(2, 2)
If Cells(3, 2) <> "" Then
mbgzb = Cells(3, 2)
If Cells(4, 2) <> "" Then
fll = Cells(4, 2)
If Cells(5, 2) <> "" Then
bth = Cells(5, 2)
Application.ScreenUpdating = False
Application.DisplayAlerts = 0
Workbooks.Open mbwj
With ActiveSheet
dqxh = ActiveSheet.Index
Set DataSheet = ActiveWorkbook.Sheets(mbgzb)
If DataSheet Is Nothing Then
MsgBox "待拆分的工作表不存在，请确认名称输入正确。"
Exit Sub
Else
oldnum = Sheets.Count
Recount = DataSheet.Range(fll & "65535").End(xlUp).Row + 1
For nx = bth + 1 To Recount
Tx = DataSheet.Range(fll & nx).Value '第一栏为要分的类
If Tx <> vbNullString Then
For x = 1 To Sheets.Count
If Sheets(x).Name = Tx Then
GoTo 100
End If
Next
https://www.wendangku.net/doc/e49022412.html, = Tx
DataSheet.Rows(bth & ":1").Copy Sheets(Tx).Range("A1") '标题列位置
100:
hs = Sheets(Tx).Range(fll & "65535").End(xlUp).Row + 1
' MsgBox hs
DataSheet.Rows(nx & ":" & nx).Copy Sheets(Tx).Range("A" & hs) '数据复制范围
' MsgBox nx
Exit Sub
End If
Next
newnum = Sheets.Count
ce = newnum - oldnum
x = 0
For Each sh In Worksheets
With Workbooks.Add
With ActiveSheet
hs = sh.Range("A65535").End(xlUp).Row
sh.Rows(hs & ":" & 1).Copy .Cells(1, 1)
.Name = https://www.wendangku.net/doc/e49022412.html,
End With
If x >= dqxh - 1 And x < ce + dqxh - 1 Then
If Dir(ThisWorkbook.Path & "\拆分" & WorksheetFunction.Text(Date, "yyyymmdd"), 16) = Empty Then
MkDir ThisWorkbook.Path & "\拆分" & WorksheetFunction.Text(Date, "yyyymmdd")
End If
Filename = ThisWorkbook.Path & "\拆分" & WorksheetFunction.Text(Date, "yyyymmdd") & "\" & https://www.wendangku.net/doc/e49022412.html,
.SaveAs Filename:=Filename
End If
.Close
End With
x = x + 1
Next
End If
Set DataSheet = Nothing
ActiveWorkbook.Close
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = 1
Else
MsgBox "请输入标题行数"
End If
Else
MsgBox "请选择特定字段所在的列"
End If
Else
MsgBox "请输入正确的待拆分工作表名称"
End If
Else
MsgBox "请选择待拆分的工作簿名称"
End If
End Sub
Sub SelectFile()
' On Error Resume Next
'选择单一文件
Dim bm(), xl As String
Dim pataSheet As Worksheet
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
'单选择
.Filters.Clear
'清除文件过滤器
.Filters.Add "Excel Files", "*.xls;*.xlsx"
.Filters.Add "All Files", "*.*"
'设置两个文件过滤器
If .Show = -1 Then
'FileDialog 对象的Show 方法显示对话框，并且返回-1（如果您按OK）和0（如果您按Cancel）。
Cells(2, 2) = .SelectedItems(1)
i = 0
Workbooks.Open Cells(2, 2)
For Each sh In Worksheets
i = i + 1
ReDim Preserve bm(i)
bm(i) = https://www.wendangku.net/doc/e49022412.html,
xl = bm(i) & "," & xl
Next
ActiveWorkbook.Close 1
Sheet1.Unprotect "7599555"
With Range("b3").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Left(xl, Len(xl) - 1)
End With
Sheet1.Protect "7599555"
Range("b3") = ""
End If
End With
End Sub
Sub 使用OUTLOOK全自动发送邮件_Click()
'要能正确发送并需要对Microseft Outlook进行有效配置On Error Resume Next
Dim rowCount, endRowNo, i, j, f$, p$, x, mailbody
Dim objOutlook As New Outlook.Application
Dim objMail As MailItem
Dim wjm()
Dim glzd, zs, cs, zt, zw, plh, qlh, llh, hh
glzd = Cells(9, 2)
zs = Cells(10, 2)
cs = Cells(11, 2)
zt = Cells(12, 2)
zw = Cells(13, 2)
'获取要发送邮件的文件列表
p = ThisWorkbook.Path & "\拆分" & Date & "\"
f = Dir(p & "*.xlsx")
i = 0
Do While f <> ""
i = i + 1
ReDim Preserve wjm(2, 1 To i)
wjm(1, i) = Left(f, (Len(f) - 5))
wjm(2, i) = f
f = Dir
Loop
With ActiveWorkbook.Sheets("通讯录")
'获取关联字段所在的列
Set x = .Cells.Find(glzd)
If Not x Is Nothing Then
plh = x.Column
Else
MsgBox "关联字段名称未找到。"
Exit Sub
End If
'获取主送地址所在的列
Set x = .Cells.Find(zs)
If Not x Is Nothing Then
qlh = x.Column
Else
MsgBox "主送字段名称未找到。"
Exit Sub
End If
'获取抄送地址所在的列
Set x = .Cells.Find(cs)
If Not x Is Nothing Then
llh = x.Column
Else
MsgBox "抄送字段名称未找到。"
Exit Sub
End If
End With
Set objOutlook = New Outlook.Application
For j = 1 To i
Set objMail = objOutlook.CreateItem(olMailItem)
With objMail
With ActiveWorkbook.Sheets("通讯录")
'获取关联字段所在的行
Set x = .Cells.Find(wjm(1, j))
If Not x Is Nothing Then
hh = x.Row
Else
MsgBox "文件名'" & wjm(2, j) & "'未找到对应的邮件地址。"
GoTo 200
End If
End With
.To = ThisWorkbook.Sheets("通讯录").Cells(hh, qlh)
.CC = ThisWorkbook.Sheets("通讯录").Cells(hh, llh)
.Subject = zt
.Body = zw
.Attachments.Add p & wjm(2, j)
.Display
DoEvents
SendKeys "%s", True
.Send
End With
200:
Set objMail = Nothing
Next
Set objOutlook = Nothing
MsgBox "邮件发送成功！"
End Sub
Sub 合并()
Dim file() As String, FileStr As String, n As Integer, PathStr As String, HeadRows As Byte, namess As String, ActiveWB As Workbook, cell As Range
On Error Resume Next
If Range("b17") = "" Then
MsgBox "请选择待合并的工作簿所在文件夹"
Exit Sub
End If
If Range("b18") = "" Then
MsgBox "请选择标题行数"
Exit Sub
End If
PathStr = Range("b17")
FileStr = Dir(PathStr & IIf(Right(PathStr, 1) = "\", "", "\") & "*.xls*") '获取路径下第一个文件名
While Len(FileStr) > 0 '只要文件名长度大于就循环下去
n = n + 1 '累加变量，该变量等于文件个数
ReDim Preserve file(1 To n) '重新指定数组变量的储存空间
file(n) = PathStr & IIf(Right(PathStr, 1) = "\", "", "\") & FileStr '将路径与文件名逐个写入数组
FileStr = Dir()
Wend
If n = 0 Then MsgBox "没发现excel文件": Exit Sub '如果没有文件则退出程序
'让用户指定标题行数，标题不参与合并
HeadRows = Range("b18")
If HeadRows < 1 Then Exit Sub '如果标题行小于1则退出程序
Application.ScreenUpdating = False '关闭屏幕更新，从而提速
Application.Calculation = xlCalculationManual '计算模式调用手动，从而提速
With Workbooks.Add
Set ActiveWB = ActiveWorkbook '将活动工作簿赋予变量
For k = 1 To n '遍历文件夹中所有Excel文件
namess = Dir(file(k)) '获取文件的名称（忽略路径）
Workbooks.Open Filename:=file(k) '找开文件
ActiveWB.Activate '返回存放合并数据的工作表
Workbooks(namess).Sheets(1).Columns("A:S").Select '选中A至S列
Selection.EntireColumn.Hidden = False '所选中的列全部取消隐藏
'如果K=1,那么将标题复制到活动工作表C1
If k = 1 Then Intersect(Workbooks(namess).Sheets(1).UsedRange, Workbooks(namess).Sheets(1).Rows("1:" & HeadRows)).Copy Cells(2, 1) 'Intersect取选2个区域的交集，其实直接用Workbooks(namess).Sheets(1).Rows("1:" & HeadRows)).Copy Cells(1, 1)就可以了
For i = 1 To Workbooks(namess).Sheets.Count '遍历所有工作表，开始合并标题以外的数据，我们在此只用工作表1，故不需要，如需要可以加上With Workbooks(namess).Sheets(i).UsedRange '引用待合并工作簿中工作表1的已用区域
If Not IsEmpty(Workbooks(namess).Sheets(i).UsedRange) Then '如果非空表
Set cell = Cells(https://www.wendangku.net/doc/e49022412.html,edRange.Rows.Count + 3, 1) '将活动工作表已用区域的下2行第1个单元格赋予变量
Intersect(.Offset(HeadRows, 0), Workbooks(namess).Sheets(i).UsedRange).Copy cell '将目标数据除标题外全部复制到cell单元格
End If
End With
Next
Workbooks(namess).Close False '并闭工作簿，且不保存
Next k
Filename = ThisWorkbook.Path & "\合并" & Date
.SaveAs Filename:=Filename
End With
Application.ScreenUpdating = True '恢复屏幕更新
Application.Calculation = xlCalculationAutomatic '恢复自动计算
End Sub
Sub wjj()
With Application.FileDialog(msoFileDialogFolderPicker) '创建文件对话框的实例
If .Show Then '如果在对话框中单击了“确定”
Range("b17") = .SelectedItems(1) '将选定的路径赋予变量
Else
Exit Sub '否则退出程序
End If
End With
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/e49022412.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/e49022412.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/e49022412.html, dirname = Dir(lj & "\*.xls") Application.ScreenUpdating = False For Each sh In Sheets https://www.wendangku.net/doc/e49022412.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表中的多个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/e49022412.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 ∣
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中的多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运行宏。
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/e49022412.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/e49022412.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合并多个工作簿中的工作表
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/e49022412.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/e49022412.html, dirname = Dir(lj & "\*.xls") Application.ScreenUpdating = False For Each sh In Sheets https://www.wendangku.net/doc/e49022412.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工作簿合并成一个新的工作簿 有多个独立的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工作表名称和结构。如果量小，可以采用打开一个个复制的方法。若有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工作簿，可以看到下方已经将之前工作簿中的工作表都复制到了这一新建工作簿中。
excel2020合并工作薄的方法
excel2020合并工作薄的方法 excel2007合并工作薄的方法： 合并工作簿步骤1：首先把需要合并的excel工作薄整理到一个文件夹中，如图，用来合并到一起的工作薄的名字要注意，这里取名叫“合并工作薄”。 合并工作簿步骤2：打开这个excel表，直接按键ALT+F11，进入下图界面。双击如图所示位置的sheet1。 合并工作簿步骤3：如图，打开准备好的VBA代码，复制到这个空白的代码编译处，代码如下： Sub工作薄间工作表合并() DimFileOpen DimXAsInteger Application.ScreenUpdating=False FileOpen=Application.GetOpenFilename(FileFilter:="Micros oftExcel文件(*.xls),*.xls",MultiSelect:=True,Title:="合并工作薄") X=1 WhileX<=UBound(FileOpen) Workbooks.OpenFilename:=FileOpen(X) Sheets().MoveAfter:=ThisWorkbook.Sheets(ThisWorkbook.She ets.Count) X=X+1 Wend
ExitHandler: Application.ScreenUpdating=True ExitSub errhadler: MsgBoxErr.Description EndSub 合并工作簿步骤5：回到“合并工作薄”的excel表格中，如图，点击工具(没有的到excel的选项中添加)，选择宏。 合并工作簿步骤6：选择宏以后会出现下图界面，直接双击图中 选项。 合并工作簿步骤7：双击后弹出选择待合并的文件夹中工作薄， 直接全选要合并的工作薄即可。
怎么将多个Excel工作簿合并成一个新的工作簿
怎么将多个Excel工作簿合并成一个新的工作簿 空行前是将多个工作簿合并到一个工作簿，之后是将新生成的工作簿中的所有工作表合并到第一个工作表中。 **************************************** Sub 合并汇总() Application.DisplayAlerts = False Application.ScreenUpdating = False FileToOpen_N = Application.GetOpenFilename("xls文件,*.xls", _ Title:="请选择要合并工作簿：", MultiSelect:=True) Newbz = 0 On Error Resume Next For Each FileToOpen In FileToOpen_N If FileToOpen <> False Then If Newbz = 0 Then Booknum = Application.SheetsInNewWorkbook Application.SheetsInNewWorkbook = 1 Workbooks.Add Application.SheetsInNewWorkbook = Booknum NewBookName = https://www.wendangku.net/doc/e49022412.html, Sheets(1).Name = "sheet_tmp" Newbz = 1 End If Set OpenBook = Workbooks.Open(FileToOpen) For Each Xlsheet In OpenBook.Sheets Xlsheet.Copy Before:=Workbooks(NewBookName).Sheets("sheet_tmp") Next OpenBook.Close SaveChanges:=False End If Next Workbooks(NewBookName).Sheets("sheet_tmp").Delete Application.ScreenUpdating = True Application.DisplayAlerts = True excel如何将一个工作簿中的多个工作表合并到一张工作表上 2012-05-05 22:34 匿名|分类：办公软件|浏览19392次 分享到： 2012-05-05 23:23 提问者采纳 打开你的工作簿新建一个工作表在这个工作表的标签上右键查看代码你把下面的代码复制到里边去，然后上面有个运行运行子程序就可以了，代码如下，如果出现问题你可以尝试工具宏宏安全性里把那个降低为中或者
多个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/e49022412.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/e49022412.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
EXCEL多个工作簿合并为一个工作簿里的多个工作表方法
EXCEL多个工作簿合并为一个工作簿里的多个工作表方法 下面说下EXCEL多个工作簿合并为一个工作簿里的多个工作表方法。 1.新建一个文件夹，把要合并的excel工作簿全部放到这个文件夹里，同时在文件夹里新建一个数据合并的工作簿；
2.打开文件夹里的数据合并工作簿，之后右键工作表选择查看代码选项打开；
3.复制以下代码到以下窗口中； Sub 工作薄间工作表合并() Dim FileOpen Dim X As Integer Application.ScreenUpdating = False FileOpen = Application.GetOpenFilename(FileFilter:="Microsoft Excel文件(*.xls),*.xls", MultiSelect:=True, Title:="合并工作薄") X = 1 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 4.点击运行按钮或者按f5键运行vba代码； 5.代码运行后会弹出要进行数据合并的文件夹，选择之前要进行数据合并创建的文件夹，按ctrl+a键全选所有的工作簿，之后点击打开；
如何将多个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 = False FilesToOpen = _ (FileFilter:="MicroSoft Excel文件(*.xls), *.xls", _ MultiSelect:=True, Title:="要合并的文件") If TypeName(FilesToOpen) = "Boolean" Then MsgBox "没有选中文件" GoTo ExitHandler End If x = 1 While x <= UBound(FilesToOpen) Filename:=FilesToOpen(x) Sheets().Move After:= x = x + 1 Wend ExitHandler: = True Exit Sub ErrHandler: MsgBox Resume ExitHandler End Sub
EXCEL合并文件及合并工作表(工作薄)的通用方法
摘要：文章：EXCEL合并文件及合并工作表(工作薄)的通用方法[原创] 摘要：使用MSOFFICEEXCEL的时候经常遇到：（1）需要将多个Excel文件进行合并；（2）需要将多个Sheet 进行合并，发表于北京联高软件有限公司技术文章栏目，代码以高亮显示。 关键字：合并, 文件, excel, 原创, 通用, sheets, thisworkbook, filestoopen, for, count, sub, next, 功能, dim, end 使用MS OFFICE EXCEL的时候经常遇到： （1）需要将多个Excel 文件进行合并； （2）需要将多个Sheet 进行合并； 这里给出最佳答案。当然您得需要会使用宏(MICRO)。 功能一：合并Excel文件 Sub CombineWorkbooks() Dim FilesToOpen, ft Dim x As Integer Application.ScreenUpdating = False On Error GoTo errhandler FilesToOpen = Application.GetOpenFilename _ (FileFilter:="Micrsofe Excel文件(*.xls), *.xls", _ MultiSelect:=True, Title:="要合并的文件") If TypeName(FilesToOpen) = "boolean" Then MsgBox "没有选定文件" End If x = 1 While x <= UBound(FilesToOpen) Set wk = Workbooks.Open(Filename:=FilesToOpen(x)) wk.Sheets().Move after:=ThisWorkbook.Sheets _ (ThisWorkbook.Sheets.Count) x = x + 1 Wend MsgBox "合并成功完成！" errhandler: End Sub 功能二：合并任意的Sheet 合并之前，请先创建一个空白的Sheet 作为合并目标Sheet ，这个Sheet 必须是第一个Sheet 哦。 如果不合并标题行（比如第一行）则j=1 改为j=2 如果数据不是从第一行，或者第一列开始的，请修改j=1 及k=2 两行的参数。
把几个Excel文档中的工作表(sheet)合并到同一工作簿中(图文精选)
把几个Excel文档中的工作表（sheet） 合并到同一工作簿中（图文） 很多时候我们需要将多个EXCEL表格的工作表合并在一个文档里面便于操作或者整理，有什么简单的方法呢？下面具体的看看如何把几个Excel文档中的工作表（sheet）合并到同一工作簿中 1、打开需要合并的所有文档 2、进入任一文档后，在工作表名处右键点击，选定"移动或复制工作表" 3、选中需要合并的文件，然后选择需要放置的顺序，确定
4、重复执行步骤三 5、保存成XLS文件格式 6、成功结果如上 怎样将多个Excel文档工作表合并到一个Excel文档中去 发布时间：2011-5-20 11:21:38 来源：厂商在线-软件直销网信息中心 现在，许多用户都在使用Excel办公软件进行表格数据的处理工作。不过，许多时候我们可能会遇到这样的问题。那就是，当我们有多个Excel文档，然后希望将这几个Excel文档中的工作表，全部合并到一个Excel文档中去的时候，该如何进行操作呢？
一、如何将Excel文档中的多个工作表合并为一个工作表 事实上，假如我们需要将一个Excel文档中的多个工作表，合并成一个工作表，那么，我们可以进行如下操作： 1、首先，我们可以先选择其他工作表的内容； 2、然后，我们运用剪切组合键（Ctrl+X），剪贴内容； 3、然后，我们再用粘贴组合键（Ctrl+V），将内容粘贴到合并后的EXCEL 文档工作表中。 二、如何将多个Excel文档中的工作表，合并到一个Excel文档 假如我们是要将多个Excel 文档中的工作表，全部合并到一个Excel文档中时，我们可以进行如下操作： 1、首先，我们打开要合并的所有的Excel 文档； 2、然后，我们右键工作表的名称，“选定全部工作表”——“移动或复制工作表”； 3、然后，我们在“工作簿”下拉框中选择目的Excel文件； 这样，便可以将多个Excel 文档中的工作表，合并到一个Excel文档了。 Excel单元格中绿色三角提示符号的去除方法
- Excel如何将一个工作表中的多个sheet合并到一个sheet中
- 多个excel文件合并成一个文件
- 把几个Excel文档中的工作表(sheet)合并到同一工作簿中(图文精选)
- excel合并工作簿和工作表的代码
- VBA方法_-_将多个excel文件合并到一个excel的多个sheet中
- 多个Excel表合并形成一个Excel中的多sheet工作簿
- 如何将多个Excel工作簿合并到一个新的工作簿的方法
- EXCEL合并文件及合并工作表(工作薄)的通用方法
- 同一EXCEL文件合并多个工作表数据到同一工作表
- 快速合并单个excel表中的多个sheet的工作页
- 批量将多个excel中的多个工作簿合并到一个excel中
- 如何将多个Excel工作簿合并成一个新的工作簿.docx
- 怎么将多个Excel工作簿合并成一个新的工作簿
- 最新excel如何将一个工作簿中的多个工作表合并到一张工作表上培训资料
- 如何将多个Excel工作簿合并成一个新的工作簿
- 合并多个excel工作薄的两种方法
- 合并EXCEL多个sheet
- excel合并工作簿和工作表的代码
- 如何将多个Excel工作簿合并成一个新的工作簿
- 如何将多个Excel工作簿合并成一个新的工作簿