求助批量填写模板表格

票留记

     急需批量处理的数据工作簿中“数据明细”分表的“B1-B5”列填写至工作簿中“发货单"分表“B1-B5”列中，并另存为发单1表的“B1”单元名称，即“名称1”.xlsx。注：模板工作簿含有其他分别需要同时保存。
      “数据明细”表中“C1-C5”、“D1-D5”类似操作。






新建文件夹.zip (22.03 KB, 下载次数: 3)

2020-3-2 23:45 上传

点击文件名下载附件

Sub 填写信息()
    Dim Irow As Long, sht As Worksheet, t As Worksheet, Rng As Range, ToFolder As String, i As Long, Inow
    Set sht = Worksheets("数据明细")
    Irow = sht.Cells(Rows.Count, 2).End(3).Row
    Set t = Worksheets("发货单")
    ToFolder = ThisWorkbook.Path & "\"
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set Rng = t.[B2:B5]

    'Set Rng = Union(t.[B3], t.[D3], t.[F3], t.[B5:B6], t.[D5:D6], t.[F5:F6], t.[B8], t.[D8], t.[F8])
    For i = 2 To Irow
        Rng.Value = ""
        t.[B2].Value = sht.Cells(2, i).Value
        t.[B3].Value = sht.Cells(2, i).Value
        t.[B4].Value = "'" & sht.Cells(2, i).Value
        t.[B5].Value = "'" & sht.Cells(2, i).Value
        t.Cells.EntireColumn.AutoFit
        t.Copy
        ActiveSheet.Name = sht.Cells(2, i).Value
        ActiveWorkbook.SaveAs ToFolder & sht.Cells(2, i).Value & ".xlsx"
        ActiveWorkbook.Close
    Next
    Rng.Value = ""
    Application.DisplayAlerts = False
    Application.ScreenUpdating = True
    MsgBox "操作完成,单击【确定】按钮查看结果。", vbInformation
    Shell "explorer.exe " & ToFolder, vbNormalFocus
End Sub

票留记

求助