[已解决]生成新表

gaogege852 · 发表于 2013-3-20 17:17

请各位大师们帮忙写一个代码，可以生成新的表册文件，具体要求在附件中的名册中。

最佳答案

爱疯

2013-3-20 18:11

Sub test()
Dim A, p$, i%

Application.ScreenUpdating = False
Application.DisplayAlerts = False
A = ThisWorkbook.Sheets(1).Range("a1").CurrentRegion
p = ThisWorkbook.Path & "\"
For i = 2 To UBound(A)
      With Workbooks.Open(p & "评价模板.xls")
         With .Sheets(1)
            .Cells(3, 1) = A(i, 3) '学生姓名
            .Cells(3, 2) = A(i, 6)  '学籍号
            .SaveAs p & A(i, 6) & A(i, 3)
         End With
         .Close
      End With
Next i
MsgBox "完成"
End Sub

评价2.rar (15.11 KB, 下载次数: 29)

爱疯 · 发表于 2013-3-20 18:11

Sub test()
Dim A, p$, i%

Application.ScreenUpdating = False
Application.DisplayAlerts = False
A = ThisWorkbook.Sheets(1).Range("a1").CurrentRegion
p = ThisWorkbook.Path & "\"
For i = 2 To UBound(A)
      With Workbooks.Open(p & "评价模板.xls")
         With .Sheets(1)
            .Cells(3, 1) = A(i, 3) '学生姓名
            .Cells(3, 2) = A(i, 6)  '学籍号
            .SaveAs p & A(i, 6) & A(i, 3)
         End With
         .Close
      End With
Next i
MsgBox "完成"
End Sub

评价2.rar (15.11 KB, 下载次数: 29)

		自动登录	找回密码
密码			注册