【原创】如何将多个工作簿中相同格式的工作表合并到一个工作表中
2014-07-10 17:05
232 查看
如何将多个工作簿中相同格式的工作表合并到一个工作表中
Sub Books2Sheets() '定义对话框变量 Application.ScreenUpdating = False 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(tempwb.Name, ".xls", "") '关闭被合并工作簿 tempwb.Close SaveChanges:=False i = i + 1 Next vrtSelectedItem End If End With Set fd = Nothing Sheets("Sheet1").Select Sheets("Sheet1").Name = "汇总" MsgBox "现在已经过个工作簿中的sheet表合并到了一个工作簿中,现在开始将相同格式的工作表合并到一个sheet表中" Sheets("汇总").Select Call NsheetsTo1sheet Application.ScreenUpdating = True End Sub Sub NsheetsTo1sheet() Application.ScreenUpdating = False For j = 1 To Sheets.Count If Sheets(j).Name <> ActiveSheet.Name 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, "提示" End Sub
相关文章推荐
- EXCEL 如何将多个工作表或工作簿合并到一个工作表
- 关于将不同工作簿中格式相同工作表合并到另一工作簿中的代码再讨论
- (原创)如何将Nios II硬件和软件合成一个文件(NIOS II)(硬件)(软件)(合并)
- excel如何快速把多个工作表合并到一个excel表
- 如何使Excel在打开一个工作簿文件时总显示其中某个特定的工作表上?
- Visio如何合并多张工作表(将多个文件合并成一个文件)
- Excel格式相同表格合并成一个
- 关于合并相同格式工作簿到同一空白工作簿的再讨论
- 通过VBA将多个格式相同的Excel文件合并成一个文件,带文件处理
- 在Excel里如何将多个工作簿合并到一个工作簿中
- 如何将EXCEL中同一个工作薄多张工作表合并
- Excel学习笔记002-004:如何合并工作表或工作簿?
- 刚写的一个合并纵向相同的行,常用
- 如何用一条SQL语句,将多条记录(一个字段)合并为一个?
- 如何识别一个影像文件是mpeg1或mpeg2的格式(大富翁收集)
- C++中如何将一个类或者对象以二进制格式保存和读入
- 合并多个格式相同XLS的方法
- 右键点击修改Grid的单列值,及修改全表的值,还有相同点击事件的代码简化,及如何双击关闭一个tabsheet
- 模块风格设置:如何为其中一类,或其中一个设置独特的风格呢?【www.4fbbs.cn论坛Joomla_ing原创】
- 如何将两个域名合并到一个alexa排名数据