office excel文件有工作簿,里面存放一张张表,表的名字叫做标签名,簿名就是我们常见的的文件名,簿的类型有“一簿一表”与“一簿多表”。
完成将多张表合并到一个工作簿中,并为表标签命名,增加制表日期。
簿与簿直接的操作基本如下:
1.一簿一表之间的复制 一对一
2.多个一簿一表的合并
3.多个一簿多表与一簿一表的合并
现在在目录下新建文件夹test,并在里面新建2个一簿3表的excel文件li1,li2,其中li1中3张表的标签分别为a\b\c,li2中表的标签分别为1、2、3,1个一簿1表的excel文件li0,表标签为0.
如图所示
一簿一表之间的复制
Sub 一簿一表之间的复制
Application.ScreenUpdating = F
Dim wb As Workbook
filename = "C:\Users\liyi\Desktop\test" & "\li1.xlsx"
Set wb = Workbooks.Add
Dim tempwb As Workbook
Set tempwb = GetObject(filename)
tempwb.Worksheets(1).Copy before:=wb.Worksheets(wb.Worksheets.Count)
wb.SaveAs ThisWorkbook.Path & "\一簿一表之间的复制.xlsx"
wb.Close
End Sub
这样就把li1中的表a,复制到新建的表中,并插在默认第一张表之前。
结果如图
多个一簿一表之间的合并
Sub 多个一簿一表的合并()
Application.ScreenUpdating = F
Dim wb As Workbook, filename As String
filename = Dir("C:\Users\liyi\Desktop\test" & "\li*.xlsx") ' dir函数遍历文件,并将文件名赋值给filename
Set wb = Workbooks.Add
Dim tempwb As Workbook, fn As String
Do While filename <> ""
fn = "C:\Users\liyi\Desktop\test" & "\" & filename '将文件路径赋值给fn
Set tempwb = GetObject(fn) '获取到该文件
tempwb.Worksheets(1).Copy before:=wb.Worksheets(wb.Worksheets.Count)
ActiveSheet.Name = Left(filename, Len(filename) - 5) & "_" & tempwb.Worksheets(1).Name
'以工作簿的名字加上"_"加上表标签为新簿中的表命名
filename = Dir
Loop
Application.DisplayAlerts = False '“删除工作表警告提示” 取消
Sheets("sheet1").Delete '删除新建簿时默认生成的sheet1
Application.DisplayAlerts = True
wb.SaveAs ThisWorkbook.Path & "\多个一簿一表的合并.xlsx"
wb.Close
End Sub
新簿是将3个文件中的第一张表复制到新簿,并重新命名
结果如图:
多个一簿多表的合并
Sub 多个一簿多表的合并()
Application.ScreenUpdating = F
Dim wb As Workbook, filename As String, fn As String
filename = Dir("C:\Users\liyi\Desktop\test" & "\li*.xlsx")
Set wb = Workbooks.Add
Dim tempwb As Workbook
Do While filename <> ""
fn = "C:\Users\liyi\Desktop\test" & "\" & filename
Set tempwb = GetObject(fn)
Dim sht As Worksheet
For Each sht In tempwb.Worksheets
sht.Copy before:=wb.Worksheets(wb.Worksheets.Count)
ActiveSheet.Name = Left(filename, Len(filename) - 5) & "_" & sht.Name
Next
filename = Dir
Loop
Application.DisplayAlerts = False '“删除工作表警告提示” 取消
Sheets("sheet1").Delete
Application.DisplayAlerts = True
yue = Month(Date - 1)
ri = Day(Date - 1)
wb.SaveAs ThisWorkbook.Path & "\多个一簿多表的合并()" & yue & ri & ".xlsx"
wb.Close
End Sub
结果如图