先来看看要解决的问题

如图1，在一张Excel工作表中，保存了许多订单信息。

图1 订单信息数据明细

同时还有一张保存发货单模板的工作表，如图2。

图2 发货单模板

现需要将图1工作表中每条订单信息填到图2发货单模板中，保将结果保存为不同的工作簿，文件以订单编号信息命名，如图3。

图3 希望得到的发货单工作簿

看看用VBA怎么解决这个问题

步骤一：按打开VBE窗口

步骤二：在新打开窗口左侧的【工程】窗口空白处单击鼠标右键，执行【插入】 →【模块】命令，如图4。

图4 插入模块

步骤三：双击插入的模块，在右侧【代码窗口】中输入下面的代码，如图5.

<code>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.Range("A1").CurrentRegion.Rows.Count 

    Set t = Worksheets("发货单")
    ToFolder = ThisWorkbook.Path & "\"
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    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.[B3].Value = sht.Cells(i, "A").Value
        t.[D3].Value = sht.Cells(i, "B").Value
        t.[F3].Value = "'" & sht.Cells(i, "C").Value
        t.[B5].Value = "'" & sht.Cells(i, "D").Value
        t.[B6].Value = "'" & sht.Cells(i, "G").Value
        t.[D5].Value = sht.Cells(i, "E").Value
        t.[D6].Value = sht.Cells(i, "H").Value
        t.[F5].Value = "'" & sht.Cells(i, "F").Value
        t.[F6].Value = sht.Cells(i, "I").Value
        t.[B8].Value = sht.Cells(i, "J").Value
        t.[D8].Value = "'" & sht.Cells(i, "K").Value
        t.[F8].Value = sht.Cells(i, "L").Value
        t.Cells.EntireColumn.AutoFit
        t.Copy
        ActiveSheet.Name = sht.Cells(i, "D").Value
        ActiveWorkbook.SaveAs ToFolder & sht.Cells(i, "D").Value & ".xlsx"
        ActiveWorkbook.Close
    Next
    Rng.Value = ""
    Application.DisplayAlerts = False
    Application.ScreenUpdating = True
    MsgBox "操作完成,单击【确定】按钮查看结果。", vbInformation
    Shell "explorer.exe " & ToFolder, vbNormalFocus
End Sub/<code>