1.自动处理工作表之 新建工作簿
Sub qqq()
'读取表名,赋值给str1
For i = 2 To 5
str1 = Range("g" & i)
'选择内容,数据透视表中按车间选择
ActiveSheet.PivotTables("数据透视表2").PivotFields("车间").ClearAllFilters
ActiveSheet.PivotTables("数据透视表2").PivotFields("车间").CurrentPage = str1
Range("I5:K18").Select
Selection.Copy
'录制宏中不获得新建工作簿(Excel文件)
Workbooks.Add
ActiveWorkbook.Sheets("Sheet1").Select
Range("A1").Select
ActiveWorkbook.ActiveSheet.Paste
'保存的路径名称
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path + "\" + str1 + ".xlsx"
ActiveWindow.Close
'debug一下路径
Debug.Print ThisWorkbook.Path
'+ "\" + str1 + ".xlsx"
' 结束后回到原工作表
Windows("车间数据bbbbb.xlsx").Activate
Sheets("Sheet1").Select
Next
End Sub
结果 自动新建了4个表格文件
2.自动处理工作表之 新建工作表
Sub aaaa()
For i = 2 To 5
Dim car As String
'选中表格
'让表格中 gI 的值等于car
Sheets("Sheet1").Select
car = Range("g" & i)
'录制宏获取透视表筛选代码
ActiveSheet.PivotTables("数据透视表2").PivotFields("车间").ClearAllFilters
ActiveSheet.PivotTables("数据透视表2").PivotFields("车间").CurrentPage = car
Range("I5:K17").Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
'更改表名
Sheets(i).Name = car
Next
End Sub
结果 直接在表内生成4个sheet工作表
3.自动处理工作表之 新建到 Word文档
Sub a1()
For i = 1 To 4
'case
'创建应用
Set wdapp = CreateObject("word.application")
'创建Word文档
wdapp.documents.Add
'显示应用
wdapp.Visible = True
num = Application.CountIf(Range("a:a"), Range("f" & i))
'创建表格
wdapp.documents(1).Tables.Add Range:=wdapp.Selection.Range, NumRows:=num + 1, NumColumns:=4
'更改样式
wdapp.documents(1).Tables(1).Style = "浅色底纹 - 强调文字颜色 3"
'创建第一行的标题头
n = 1
For j = 1 To 4
wdapp.documents(1).Tables(1).Range.Cells(n) = Cells(1, j)
n = n + 1
Next
'内容搬运模块
For k = 2 To Application.CountA(Range("a:a"))
If Range("a" & k) = Range("f" & i) Then
For m = 1 To 4
wdapp.documents(1).Tables(1).Range.Cells(n) = Cells(k, m)
n = n + 1
Next
End If
Next
'另存为
wdapp.documents(1).SaveAs ThisWorkbook.Path + "\" + Range("f" & i) + ".docx"
'退出
wdapp.Quit
Next
End Sub
练习资源地址:https://pan.baidu.com/s/1Y3d0n0BSkRk8CUwr8o-CIA