vba脚本（通过模板和数据表生成多个表）

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Attribute VB_Name = "模块"
Sub 由模板生成()
Attribute 由模板生成.VB_ProcData.VB_Invoke_Func = " n14"
  
    Dim outdir As String
    
    'outdir 输出文件目录
    outdir = "D:output"
    If dir(outdir) = "" Then
        MkDir outdir
    End If
     
     
    If Sheets.Count > 2 Then
        For i = 3 To Sheets.Count
            Sheets(3).Delete
        Next
    End If
       
    For i = 2 To 4 Step 1
        Sheets("模板").Copy After:=Sheets(Worksheets.Count)
        Sheets(Worksheets.Count).Name = Sheets("数据源").Cells(i, 1)
        ActiveSheet.Cells(2, 2) = Sheets("数据源").Cells(i, 1)
        ActiveSheet.Cells(3, 2) = Sheets("数据源").Cells(i, 2)
        ActiveSheet.Cells(4, 2) = Sheets("数据源").Cells(i, 3)
        
    Next
    
    ActiveWorkbook.Save
    
    ' True:输出为单个文件
    ' False:输出到当前工作簿其他sheet
    If True Then
        If Sheets.Count > 2 Then
            For i = 3 To Sheets.Count
                Sheets(3).Select
                file = Sheets(3).Name
                Sheets(3).Move
                ActiveWorkbook.SaveAs Filename:=outdir + file + ".xlsx", _
                    FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
                ActiveWorkbook.Close
            Next
        End If
    End If
        
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    Application.Quit
        
End Sub