|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
Sub 批量生成()
Application.ScreenUpdating = False
Dim ar As Variant
With Sheets("sheet1")
r = .Cells(Rows.Count, 1).End(xlUp).Row
If r < 2 Then MsgBox "列表为空!": End
ar = .Range("a1:b" & r)
End With
For i = 2 To UBound(ar)
If Trim(ar(i, 1)) <> "" Then
Sheets("模板").Copy
Set wb = ActiveWorkbook
With wb.Worksheets(1)
.Name = "检验批"
.[az7] = ar(i, 2)
.[az8] = ar(i, 1)
End With
wb.SaveAs Filename:=ThisWorkbook.Path & "\" & ar(i, 1) & ".xls", FileFormat:=xlExcel8
wb.Close
End If
Next i
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub |
|