Excel学习笔记002-004:如何合并工作表或工作簿?
现在想解决的问题是:①如何把不同工作簿中相同格式的工作表合并到新工作簿中?②如何把同一工作簿中相同格式的工作表合并到同一工作表?
先来解决第1个问题:如何把不同工作簿中相同格式的工作表合并到新工作簿中
Sub 如何合并工作簿至同一工作簿中()
'首先遍历指定文件夹下的所有xls文件
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim i, k, totalR1, totalC1, totalR2, totalC2 As Integer
Dim sr As FileSearch '定义一个文件搜索对象
Set sr = Application.FileSearch
sr.LookIn = "E:xiehui" '注意路径,换成你实际的路径
sr.Filename = "*.xls" '搜索所有文件
sr.Execute '执行搜索
Cells.Delete '表格清空
'存入指定位置,也可以不存.
For i = 1 To sr.FoundFiles.Count
Cells(i, 1) = sr.FoundFiles(i) '每一行第一列填写一个文件名
Next
Workbooks.Add
ActiveWorkbook.SaveAs Filename:="e:合并.xls"
'读取第1个文件,提取标题行
Workbooks.Open sr.FoundFiles(1)
Range("A1").EntireRow.Copy
'添加标题行
Workbooks("合并.xls").Activate '不明白为什么加上路径名就不行执行呢?提示说运行时错误9,下标超界!!但只加文件名就可以执行!!!!
Range("A1").PasteSpecial xlPasteAll
Application.CutCopyMode = False
'顺次读取文件名,按取相应数据进行填充
For i = 1 To sr.FoundFiles.Count
Workbooks.Open sr.FoundFiles(i)
totalR1 = Range("A1").CurrentRegion.Rows.Count
totalC1 = Range("A1").CurrentRegion.Columns.Count
Range(Cells(2, 1), Cells(totalR1, totalC1)).Copy
Workbooks("合并.xls").Activate
totalR2 = Range("A1").CurrentRegion.Rows.Count
Range(Cells(totalR2 + 1, 1), Cells(totalR2 + 1, 1)).PasteSpecial xlPasteAll
Application.CutCopyMode = False
Range("A1").CurrentRegion.EntireColumn.AutoFilter
Next i
End Sub
下面解决第②个问题:如何把同一工作簿中不同工作表合并到同一工作表(或工作簿)
Sub 如何把同一工作簿中不同工作表合并到同一工作表或工作簿中()
'创建多个工作表,利用筛选来进行保证数据的有效性
Dim i, totalR1, totalR2, totalC1, totalC2 As Integer
For i = 1 To 20
Worksheets("sheet1").Activate '此工作表存放需要筛选的原始数据!依情况而定工作表名
Range("A1").AutoFilter
Range("A1").AutoFilter field:=2, Criteria1:=Str(i)
Range("A1").CurrentRegion.Copy
Worksheets.Add after:=Worksheets("sheet1")
Range("A1").PasteSpecial
Application.CutCopyMode = False
ActiveSheet.Name = Format(Str(i)) & "班"
Range("A1").CurrentRegion.Columns.AutoFit
Next i
Range("A1").EntireRow.Copy
'以上面为基础,演示如何进行把多个格式完全相同的工作表合并到同一个工作簿中
Worksheets.Add after:=Worksheets("sheet1")
ActiveSheet.Name = "合并"
Range("A1").PasteSpecial xlPasteAll
For i = 1 To 20
Worksheets(Format(Str(i)) & "班").Activate
totalR1 = Range("A1").CurrentRegion.Rows.Count
totalC1 = Range("A1").CurrentRegion.Columns.Count
Range(Cells(2, 1), Cells(totalR1, totalC1)).Copy
Worksheets("合并").Activate
totalR2 = Range("A1").CurrentRegion.Rows.Count
Range(Cells(totalR2 + 1, 1), Cells(totalR2 + 1, 1)).PasteSpecial xlPasteAll
Application.CutCopyMode = False
Next i
Range("A1").CurrentRegion.Columns.AutoFit
End Sub