|
参与一下。。。- Sub ykcbf() '//2024.3.23
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- Set sh = Sheets("导入协议")
- p = ThisWorkbook.Path & ""
- With Sheets("数据")
- r = .Cells(Rows.Count, 1).End(3).Row
- arr = .[a1].Resize(r, 6)
- End With
- For i = 2 To UBound(arr)
- fn = sh.Name & arr(i, 1)
- With sh
- .[d2] = arr(i, 3)
- .[b3] = arr(i, 2)
- .[b4] = arr(i, 4)
- .[c14] = arr(i, 5)
- .[d14] = arr(i, 6)
- .[h2] = Format(arr(i, 1), "000")
- End With
- sh.Copy
- Set wb = ActiveWorkbook
- wb.Sheets(1).Name = fn
- wb.Sheets(1).DrawingObjects.Delete
- wb.SaveAs p & fn
- wb.Close
- Next
- Application.ScreenUpdating = True
- MsgBox "OK!"
- End Sub
复制代码
|
|