VBA 表格操作2 表格复制

时间:2022-10-21 14:41:30

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.

如图所示

VBA 表格操作2  表格复制

一簿一表之间的复制

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,复制到新建的表中,并插在默认第一张表之前。

结果如图

VBA 表格操作2  表格复制

多个一簿一表之间的合并

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个文件中的第一张表复制到新簿,并重新命名

结果如图:

VBA 表格操作2  表格复制

多个一簿多表的合并

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

结果如图

VBA 表格操作2  表格复制