20170727xlVBA根据数据表和模板工作簿生成个人明细表工作簿

Sub CreateTables()
    Dim Wb As Workbook
    Dim OpenWb As Workbook
    Dim Sht As Worksheet
    Dim Rng As Range
    Dim Arr As Variant
    Dim i As Long
    Const HEAD_ROW As Long = 2
    Dim EndRow As Long
 
    '模板文件名和路径
    Const ModelName As String = "社+名.xlsx"
    Dim ModelPath As String
    '生成文件名和路径
    Dim NewName As String
    Dim NewPath As String
 
    Set Wb = Application.ThisWorkbook
    Set Sht = Wb.Worksheets("明细表")
 
    ModelPath = Wb.Path & "\模板\" & ModelName    '社+名的完整路径
 
    With Sht
        EndRow = .Cells(.Cells.Rows.Count, "A").End(xlUp).Row
        '内置方法，返回A列最后一个非空单元格行号
 
        Set Rng = .Range(.Cells(HEAD_ROW + 1, "A"), .Cells(EndRow, "I"))
        '引用区域，左上角单元格，右下角单元格，这样就获取数据区域了 自己领悟一下就知道了
 
        Arr = Rng.Value
        '存在一个数组里面，这样速度好很多
        '和单元格区域是一样的。只是它只有数据，没有框框颜色字体什么的，所以用起来很快
 
        Set OpenWb = Application.Workbooks.Open(ModelPath)
        '打开模板文件
 
        For i = LBound(Arr) To UBound(Arr)    '从第一行到最后一行，逐行循环
            'arr相当于是一个有行列结构的数组，和单元格区域是一样的。Lbound可以取到开始行，Ubound可以取到结束行
 
            '开始构建新文件名
            NewName = Arr(i, 9) & "-" & Arr(i, 2) & ".xlsx"
            'i是可变的，9就是第I列 经办行，2就是第B列的客户名称,新文件名就弄好了
            NewPath = Wb.Path & "\生成\" & NewName
            '新文件名的完整路径 就构造好了
 
            '开始填表
            '这里就做两个示范，剩下的你自己填就知道了
            '第一个sheet
            OpenWb.Worksheets("（一）档案封皮").Range("B13").Value = Arr(i, 2)    '借款人
            OpenWb.Worksheets("（一）档案封皮").Range("A23").Value = Arr(i, 9)    '经办行
 
            OpenWb.Worksheets("（二）债务主体认定书").Range("B4").Value = Arr(i, 2)    '经办行
            OpenWb.Worksheets("（二）债务主体认定书").Range("B5").Value = "'" & Arr(i, 1)   '贷款号
           '注意注意注意   长数字 前面一定要加上  "'" &  ，这样防止后面三位数字变成 000
 
            '************剩下自己弄
 
            OpenWb.SaveCopyAs NewPath    '填完就另存副本
 
        Next i
 
        OpenWb.Close False    '关掉模板
    End With
 
    '释放对象，告诉内存，这些东东我不要了，不然一直占着内存
    Set Wb = Nothing
    Set OpenWb = Nothing
    Set Sht = Nothing
    Set Rng = Nothing
    Erase Arr    '擦除数组
 
End Sub