1.如何合并多个excel文件
如何合并多个excel文件！
有一个文件夹下有很多个excel文件，每个excel里面只有一个表。怎么将这些表合并到一个EXCEL文件中
常见问题,执行下面的宏
Sub huizhong()
Dim fd As FileDialog
Dim Wbook As Workbook
Dim rowindex As Integer
Set fd = Application.FileDialog(msoFileDialogFilePicker)
Dim vrtSelectedItem As Variant
With fd
.Filters.Add "EXCEL 文件", "*.xls", 1 '过滤
If .Show = -1 Then
rowindex = 1
For Each vrtSelectedItem In .SelectedItems
Set Wbook = Workbooks.Open(vrtSelectedItem)
subrowindex = 1 '每个表从第一行开始
Do While Wbook.Worksheets("Sheet1").Cells(subrowindex, 1) <> ""
'假设被汇总的excel文件名为"综合表",表名为sheet1.
Workbooks("综合表.xls").Worksheets("Sheet1").Cells(rowindex, 1) = Wbook.Worksheets("Sheet1").Cells(subrowindex, 1).Value '以下是对每一行进行赋值Workbooks("综合表.xls").Worksheets("Sheet1").Cells(rowindex, 2) = Wbook.Worksheets("Sheet1").Cells(subrowindex, 2).Value
subrowindex = subrowindex + 1
rowindex = rowindex + 1
Loop
Wbook.Close
Next vrtSelectedItem
Else
End If
End With
Set fd = Nothing
End Sub
运行后再选择要合并的文档，
Sub aa()
Dim fd As FileDialog
Dim Wbook As Workbook
Dim rowindex As Integer
Set fd = Application.FileDialog(msoFileDialogFilePicker)
Dim vrtSelectedItem As Variant
With fd
.Filters.Add "EXCEL 文件", "*.xls", 1 '过滤
If .Show = -1 Then
rowindex = 1
For Each vrtSelectedItem In .SelectedItems
Set Wbook = Workbooks.Open(vrtSelectedItem)
subrowindex = 1 '每个表从第一行开始
Do While Wbook.Worksheets("Sheet1").Cells(subrowindex, 1) <> ""
'假设被汇总的excel文件名为"新建Microsoft Excel 工作表",表名为sheet1.
Workbooks("新建Microsoft Excel 工作表.xls").Worksheets("Sheet1").Cells(rowindex, 1) = Wbook.Worksheets("Sheet1").Cells(subrowindex, 1).Value '以下是对每一行进行赋值Workbooks("新建Microsoft Excel 工作表.xls").Worksheets("Sheet1").Cells(rowindex, 2) = Wbook.Worksheets("Sheet1").Cells(subrowindex, 2).Value
Workbooks("新建Microsoft Excel 工作表.xls").Worksheets("Sheet1").Cells(rowindex, 3) = Wbook.Worksheets("Sheet1").Cells(subrowindex, 3).Value
Workbooks("新建Microsoft Excel 工作表.xls").Worksheets("Sheet1").Cells(rowindex, 4) = Wbook.Worksheets("Sheet1").Cells(subrowindex, 4).Value
Workbooks("新建Microsoft Excel 工作表.xls").Worksheets("Sheet1").Cells(rowindex, 5) = Wbook.Worksheets("Sheet1").Cells(subrowindex, 5).Value
Workbooks("新建Microsoft Excel 工作表.xls").Worksheets("Sheet1").Cells(rowindex, 6) = Wbook.Worksheets("Sheet1").Cells(subrowindex, 6).Value
Workbooks("新建Microsoft Excel 工作表.xls").Worksheets("Sheet1").Cells(rowindex, 7) = Wbook.Worksheets("Sheet1").Cells(subrowindex, 7).Value
Workbooks("新建Microsoft Excel 工作表.xls").Worksheets("Sheet1").Cells(rowindex, 8) = Wbook.Worksheets("Sheet1").Cells(subrowindex, 8).Value
Workbooks("新建Microsoft Excel 工作表.xls").Worksheets("Sheet1").Cells(rowindex, 9) = Wbook.Worksheets("Sheet1").Cells(subrowindex, 9).Value
subrowindex = subrowindex + 1
rowindex = rowindex + 1
Loop
Wbook.Close
Next vrtSelectedItem
Else
End If
End With
Set fd = Nothing
End Sub
通过VBA宏合并Excel工作表
今天火车票到手，最重要的事情搞定啦，庆祝一下~
昨天跟盼盼说要写一篇她看得懂的，小路从来都是言而有信的人~想了半天，对于Excel，我只会玩宏，所以有了这一篇日志~
咳咳，切入正题。工作中经常会用到的把几个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) Next
ExitSub:
Application.ScreenUpdating = True
End Sub
这段代码在干嘛？它首先打开一个文件选择框，你可以选择一个或多个文件，然后把这些文件里的所有Sheet合并到当前这个工作簿里来，有重名的Sheet会自动在后面加数字。嗯，接下来可以进行第二歩鸟~
2. 合并工作表
同上，再添加一个模块吧，代码如下
查看源码
打印关于
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
'新建一个“汇总”工作表
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("汇总").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Set DestSh = ActiveWorkbook.Worksheets.Add
https://www.360docs.net/doc/817717812.html, = "汇总"
'开始复制的行号，忽略表头，无表头请设置成1
StartRow = 2
For Each sh In ActiveWorkbook.Worksheets
If https://www.360docs.net/doc/817717812.html, <> https://www.360docs.net/doc/817717812.html, 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
这一大坨又在干嘛？它会新建一个叫做“汇总”的工作表，然后把当前工作簿里的所有Sheet 里有数据的内容都复制到“汇总”表里。提示：如果数据表里的内容没有表头的话需要把StartRow = 2改成StartRow = 1哦。
Alt+F11插入一个模块，先运行MergeWorkbooks,再运行MergeSheets.可解决每个Excel表中sheet1的命名是不一样时的情况。
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
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
'新建一个"汇总"工作表
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("汇总").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Set DestSh = ActiveWorkbook.Worksheets.Add
https://www.360docs.net/doc/817717812.html, = "汇总"
'开始复制的行号，忽略表头，无表头请设置成1
StartRow = 2
For Each sh In ActiveWorkbook.Worksheets
If https://www.360docs.net/doc/817717812.html, <> https://www.360docs.net/doc/817717812.html, 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
Public Sub data_entry()
' Macro recorded 12/26/2007 by cn0k0710
Dim i As Integer '获取的数据的最后行号
Dim i1 As Integer '汇总的文件的空白行号
Dim i2 As Integer '打开的文件个数
Dim Fname As String '文件的名称
Dim Sname As String '表格页的名称
Dim userfilename As String
Dim WB As Workbook
Dim count As Integer '用户名列表和行号，循环查询时用
Dim Count1 As Integer '用户名工作表名称，循环查询时用
Dim Sumsheets As Integer '工作表的数量
Dim name2 As String 'test
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'通过名城列表获取文件名，容易和sc2文件夹中的文件名不一致
'For count = 6 To 7 '4 to 17 人员列表
' Fname = Range("C" & count).Value
' If Fname = "" Then
' wb.Close
' GoTo ErrorHandler
' End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'通过手动录入获取文件名
'Fname = Application.InputBox("Enter a Fname")
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sheet1.Select
Range("B2:I1000").Select
Selection.Value = ""
FileToOpen = Application.GetOpenFilename("Excel Files (*.xls), *.xls", , "Please select the files...", , True)
If IsArray(FileToOpen) = 0 Then
'MsgBox "没有选择文件"
MsgBox "No files are selected!"
Exit Sub
End If
For i2 = 1 To UBound(FileToOpen)
'Open a worksheet
'GoOn:
userfilename = FileToOpen(i2)
Set WB = Workbooks.Open(userfilename)
userfilename = https://www.360docs.net/doc/817717812.html,
Fname = GetUserName(userfilename)
If Fname = "" Then
WB.Close
GoTo ErrorHandler
End If
'Workbooks.Open filename:="D:\Daily Work\performance appraisal\SC2\" & Fname & ".xls" '打开文件
Windows(userfilename).Activate
Sheets("Project report").Select
i = ERow() - 1 '查找最后的非空行
' Range("C2:D" & i).Select
' Selection.NumberFormat = "yyyy/mm/dd;@"
Range("B2:I" & i).Copy
WB.Close
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sheet1.Activate
i1 = ERow() '查找空白行号
Range("B" & i1 & ":I" & i1 + i - 2).Activate
ActiveCell.PasteSpecial
'格式修饰
'''''''''''''''''''''''''''''''''''''''
Range("C6:D1000").Select
Selection.NumberFormat = "yyyy/mm/dd;@"
With Selection
.HorizontalAlignment = xlLeft
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
Range("E6:F1000").Select
Selection.NumberFormat = "0%"
With Selection
.HorizontalAlignment = xlLeft
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
Range("H6").Select
''''''''''''''''''''''''''''''''''''''''
Application.CutCopyMode = False
Sheet1.Select
Next i2
'Next count
'ActiveWorkbook.Save
Sheet1.Select
Range("C2:F1000").Select
Selection.NumberFormatLocal = "yyyy-m-d"
Range("B2").Select
ErrorHandler:
Exit Sub
End Sub
Public Function ERow() '查找最下面的空白行
Dim count As Integer
Dim TheCell As Range
For count = 0 To 1000 '巡检范围从B1-B1000 Set TheCell = Range("B1").Offset(count, 0)
If TheCell.Value = "" Then '确认单元格为空
ERow = count + 1
Exit For
End If
Next count
End Function
'Find the user name in the given file name
'e.g.: Mike_03_2007 --> Mike
Public Function GetUserName(ByVal filename As String) As String Dim Findstr, username As String
Dim name As String
Dim pos, tempPos, length, endpos As Integer
Findstr = "_"
username = ""
pos = InStr(1, filename, Findstr)
name = Left(filename, pos - 1)
tempPos = 1
length = Len(name)
GetUserName = UCase(name)
End Function
'delete all spaces in between text
Public Function trimall(ByVal filename As String) As String Dim Findstr As String
Dim name As String
Dim pos, tempPos, length, endpos As Integer
name = Trim(filename)
Findstr = " "
Be: pos = InStr(1, name, Findstr)
If pos <> 0 Then
name = Left(name, pos - 1) & Right(name, Len(name) - pos) Else
GoTo En
End If
GoTo Be
tempPos = 1
length = Len(name)
En:
trimall = UCase(name)
End Function
如何将多个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.360docs.net/doc/817717812.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.360docs.net/doc/817717812.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工作文档进行计算
怎样合并多个Excel工作文档进行计算 Excel是MicrosoftOfficesystem中的电子表格程序。您可以使 用Excel创建工作簿(电子表格集合)并设置工作簿格式，以便分析 数据和做出更明智的业务决策。特别是，您可以使用Excel跟踪数据，生成数据分析模型，编写公式以对数据进行计算，以多种方式 分析数据，并以各种具有专业外观的图表来显示数据。简而言之：Excel是用来更方便处理数据的办公软件。 当我们对多个Excel工作表中的数据进行计算的时候，往往需要对数据进行合并，然后才能开始计算。这样才能更快的提高计算效率，下面，笔手为大家列出几个技巧，希望对大家有帮助。 一、根据位子或者分类情况来进行合并计算 当您以前未在“合并计算”对话框内选中“创建连至源数据的链接”复选框的情况下，才能更改合并计算。如果选中该复选框，请 单击“关闭”，然后重新创建合并计算。 a、单击合并计算数据的左上角单元格。 b、在“数据”选项卡的“数据工具”组中，单击“合并计算”。 c、请执行下列一项或多项操作： 二、添加源区域开始进行合并计算 新的源区域必须在相同位置中有数据，或者有与合并计算中其他区域内的那些列标签匹配的列标签 1、如果工作表在另一个工作簿中，请单击“浏览”找到文件， 然后单击“确定”以关闭“浏览”对话框。在“引用”框中输入后 跟感叹号的文件路径。 2、键入为区域指定的名称，然后单击“添加”。 三、调整源区域的大小或形状
1、在“所有引用位置”下，单击要更改的源区域。 2、在“引用”框中，编辑所选引用。 3、单击“添加”。 四、从合并计算中删除源区域 1、在“所有引用位置”中，单击要删除的源区域。 2、单击“删除”。 3、自动更新合并计算 以上几点就是合并多个Excel工作文档的一些操作技巧，希望对大家有一些帮助。
如何将多个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中如何将相同格式的多个不同excel文件合并为一张表
excel中如何将相同格式的多个不同excel文件合并为一张表？ 欧阳学文 【问题描述】：日常工作中采集的数据经常会是大量格式相同的Excel表格。（如要求多个单位上交表格，最后需要汇总这些表格的内容），如何实现自动化合并呢？ 【解决方案】： 1.将所有格式相同的Excel表格保存到一个文件夹内； 2.在文件夹内新建一个Excel工作表，命名为“汇总表”； 3.打开汇总表，按“Alt + F11”打开VBA开发环境，双击工程资源管理器里面的sheet1(sheet1),在右侧的代码区编写如下代码： Sub 合并当前目录下所有工作簿的全部工作表() Dim MyPath, MyName, AWbName Dim Wb As Workbook, WbN As String Dim G As Long Dim Num, ini As Long
Application.ScreenUpdating = False MyPath = ActiveWorkbook.Path MyName = Dir(MyPath & "\" & "*.xls") AWbName = https://www.360docs.net/doc/817717812.html, Num = 0 ini = 0 Do While MyName <> "" If MyName <> AWbName Then Set Wb = Workbooks.Open(MyPath & "\" & MyName) Num = Num + 1 With Workbooks(1).ActiveSheet If ini = 0 Then Wb.Sheets(1).Range(Wb.Sheets(1).Cells(1, 1),Wb.Sheets(1).Cells(1, Wb.Sheets(1).UsedRange.Columns.Count)).Copy .Cells(1, 1) ini=1 End If For G=1 To Sheets.Count
【实务操作Excel】跨表、跨工作簿合并之合并多个工作表
多个工作表的合并及动态更新 之利用Excel数据新建查询（Power Query）功能 当今信息化“大数据”时代，数据汇总分析已经成为财务、税务、审计人员必不可少的一项技能。作为一线审计人员，经常与数据打交道，小编更是有切身体会，各种Excel函数、并表、透视等更是家常便饭手到擒来的事情。Excel操作技能慢慢成为每一个财税人员的看家本领，基础技能，小编后续在解码财税政策实务原理的同时，将会在【工具】菜单选项模块更新一系列Excel操作小技巧，相信能够给财税工作领域的小伙伴们带来实务工作上的便利，为您的职业发展助一臂之力。今天小编打算写一篇关于跨表或跨工作簿甚至跨文件夹合并的问题，这项“神技能”可以说是财税人员很少去运用的技能，但一旦掌握，您将受益终身。更多工具搜索：爱问财税
一、跨表合并解决的问题 财务部门作为公司数据记录、归集、处理中心，是企业管理运营的核心，成本费用的列支、收入现金的记录，采购端的支出、销售端的收入，公司合并、分立、上市、清算…等等，每项业务都需要在财务、税务部门体现出来。当公司规模不大时，可以手工简单处理，靠单笔查询或脑袋记忆就能解决，但一旦公司规模扩张，尤其多元化业务发展，企业的财务或税务人员势必面临着数据归集、处理、分析的难题。 今天所讲的跨表合并主要解决财务部门在面临不同部门提交的数据、不同日期、月份、年度的数据，或者不同公司、行业的报表数据等，各项数据分散在不同的工作表、工作簿甚至文件夹中，这种情况该如何解决入如何能运用Excel的操作技巧达到快速合并的效果，可以留给更多分析、报告的时间。 二、跨表合并解决的方法 跨表合并解决的方法其实有很多种，包括数据新建查询（Power Query）、方方格子、Excel易用宝、慧办公软件、VBA函数等，那么作为财税人员，我们应该学习哪种技能既能解决问题又比较容易上手呢？那么我们先分析下这些工具具体应用场景：
EXCEL多个相同的表格合成一个表格
EXCEL多个相同的表格合成一个表格 先将30多个表合并到一个工作薄中，再将工作薄中的30多个表合并到一个工作表中，具体如下：1.新建一个excel文件并打开，按ALT+F11-->插入-->模块，将下面的代码复制到模块中： Sub merge() Dim FileSet Dim i As Integer Dim filename On Error GoTo 0 Application.ScreenUpdating = False FileSet = Application.GetOpenFilename(FileFilter:="Excel 2003(*.xls),*.xls,Excel 2007-2013(*.xls x),*.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.再一次的插入模块，左边会显示插入模块2，同样将下面代码复制到模块2中，如下： Sub 合并当前工作簿下的所有工作表() Application.ScreenUpdating = False For j = 1 To Sheets.Count If Sheets(j).Name <> https://www.360docs.net/doc/817717812.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
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.360docs.net/doc/817717812.html, dirname = Dir(lj & "\*.xls") Application.ScreenUpdating = False For Each sh In Sheets https://www.360docs.net/doc/817717812.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多个文件合并代码
然后我们把下面这些宏计算的代码复制进去，然后找到工具栏上面的“运行”下的“运行子过程/用户窗体”，代码如下，如图所示： 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.360docs.net/doc/817717812.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.360docs.net/doc/817717812.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中的多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文件合并为一个Excel文件
如何将多个Excel文件合并为一个Excel文件 有很多张excel，而且excel表里面的数据格式及公式基本一样，那么是否可以将其合并在一个excel页面呢？其实利用excel表的VB语句就可以实现，具体操作步骤如下所示：Step1：将要合并的Excel表放置在同一个文件夹里面； Step2：在该文件夹中新建Excel； Step3：打开新建Excel，在sheet1处右键，选择查看代码，进入VB代码界面； Step4：将下面“合并当前目录下所有工作簿的全部工作表”代码输入进去； 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.360docs.net/doc/817717812.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.360docs.net/doc/817717812.html, Wb.Close False End With
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.360docs.net/doc/817717812.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.360docs.net/doc/817717812.html, dirname = Dir(lj & "\*.xls") Application.ScreenUpdating = False For Each sh In Sheets https://www.360docs.net/doc/817717812.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文件合并多个工作表数据到同一工作 表 首先，添加通用函数 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.360docs.net/doc/817717812.html, = "RDBMergeSheet" '遍历所有工作表并将数据复制到DestSh For Each sh In ActiveWorkbook.Worksheets If https://www.360docs.net/doc/817717812.html, <> https://www.360docs.net/doc/817717812.html, Then '找到在工作表DestSh中带有数据的最后一行 Last = LastRow(DestSh) '设置希望复制的单元格区域 Set CopyRng=https://www.360docs.net/doc/817717812.html,edRange '测试工作表DestSh中是否有足够的行用来复制所有数据
多个excel文件快速合并成一个文件 非常好用
Excel多个文件格子如何合并？非常好用 1.先把所有要合并的EXCEL放到同一目录下. 2.在当前目录下新建一个EXCEL 3.打开新建的EXCEL 按ALT+F11 4.在sheet1里输入 -------------------------------------此行不要复制---------------- 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.360docs.net/doc/817717812.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.360docs.net/doc/817717812.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 ---------------------------此行不要复制----------------------- 5.关闭Microsoft Visual Basic
何把多个文件合并到一个Excel文档里方法
何把多个文件合并到一个Excel文档里 方法 办公软件教程PConline IT百科 日常工作当中，会产生很多Excel文档，每当需要整理的时候又很难归类、查询。这个时候就需要把诺干个Excel文档，合并到一个Excel文档里。一个Excel文档对应一个Sheet工作表，方便查询、归类、整理。下面小编就为大家介绍Excel2013把多个文件合并到一个Excel文档里方法，喜欢的朋友一起来看看吧! 表格合并 1、把需要合并的excel表格文档放到同一个文件夹里 2、新建一个“数据合并.xlsx“文档 3、打开“数据合并.xlsx“文档，在”Sheet1“工作表的地方右键→查看代码(快捷键：“Alt+F11”，尽量选用快捷方式)进入到Microsoft Visual Basic for Applications窗口 4、双击工程资源管理器里面的sheet1，在右侧的代码区粘贴如下代码： 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.360docs.net/doc/817717812.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.360docs.net/doc/817717812.html, Wb.Close False
(完整版)VBA方法_-_将多个excel文件合并到一个excel的多个sheet中
VBA方法 - 将多个excel文件合并到一个excel的多个sheet中由上级的要求，同事需要将以前做的所有excel文件（手机话费清单表），都合并到一个excel中，并且每个excel文件为一个sheet。她开始是用复制粘贴的方法，很麻烦。所有她就问我，有没有什么方法可以快点做完。 网上搜索，方法如下： 1. 将需合并的excel文件放在同一个文件中，并这个文件中新建一个excel 文件 2. 打开新建的excel文件，按alt + f11建，打开宏，新建一个模组，将下面的代码拷贝进去，并保存。 Sub Books2Sheets() '定义对话框变量 Dim fd As FileDialog Set fd = Application.FileDialog(msoFileDialogFilePicker) '新建一个工作簿 Dim newwb As Workbook Set newwb = Workbooks.Add With fd If .Show = -1 Then '定义单个文件变量 Dim vrtSelectedItem As Variant '定义循环变量 Dim i As Integer i = 1 '开始文件检索 For Each vrtSelectedItem In .SelectedItems '打开被合并工作簿 Dim tempwb As Workbook Set tempwb = Workbooks.Open(vrtSelectedItem) '复制工作表 tempwb.Worksheets(1).Copy Before:=newwb.Worksheets(i) '把新工作簿的工作表名字改成被复制工作簿文件名，这儿应用于xls文件，即Excel97-2003的文件，如果是Excel2007，需要改成xlsx newwb.Worksheets(i).Name = VBA.Replace(https://www.360docs.net/doc/817717812.html,, ".xls", "") '关闭被合并工作簿 tempwb.Close SaveChanges:=False i = i + 1 Next vrtSelectedItem End If End With Set fd = Nothing End Sub 3. 运行程序，弹出对话框，批量选择要合并的excel名，确定即可。注意：完成后，所需表格为book1,而不是那个新建excel。
如何将多个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工作簿，可以看到下方已经将之前工作簿中的工作表都复制到了这一新建工作簿中。
excel多个文件表合并(2种方法)
新建一个工作表，命名后保存到和与合并的N个文件同一个文件文件夹，按 alt + f11,双击工程资源管理器里面的sheet1(sheet1),在右侧的代码区粘贴如下代码。运行。等候一会就OK了。 宏：多个文件表合到一个文件表的多个SHEET中(sheet的名字按原文件表中sheet的名字) 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 "没有选定文件" 'GoTo errhandler 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: 'MsgBox Err.Description 'Resume errhandler End Sub 宏：多个文件表合到一个文件表的多个SHEET中(只取第一个sheet，sheet的名字按原文件的名字) Sub Books2Sheets() '定义对话框变量 Dim fd As FileDialog Set fd = Application.FileDialog(msoFileDialogFilePicker) '新建一个工作簿 Dim newwb As Workbook Set newwb = Workbooks.Add With fd If .Show = -1 Then '定义单个文件变量 Dim vrtSelectedItem As Variant
快速合并单个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.360docs.net/doc/817717812.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文件，命名后保存到和与合并的100个文件同一个文件文件夹，摁alt + f11,双击工程资源管理器里面的sheet1(sheet1),在右侧的代码区粘贴如下代码。运行。等候一会就OK了。 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.360docs.net/doc/817717812.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.360docs.net/doc/817717812.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 如果各文件都只有一个工作表，合并后要使各文件内容在不同工作表里（工作表名称与原文件相同），也就是说如10个文件，合并为一个文件，里面有10个工作表。则按上面的方法粘贴如下代码，然后单击“运行”—“运行子过程（用户窗体），然后选择要合并的文件即