|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
本帖最后由 fhv123 于 2020-2-10 22:25 编辑
将文件放到 D:\date
代码功能说明:将统计表的3至6列分别复制到模板的第3列,按名称保存好
代码的问题:生成后的工作薄第3列复制的都是统计表的最后一列,不是对应该的3-6列
Sub ss()
Excel.Application.ScreenUpdating = False
Excel.Application.CutCopyMode = False
Excel.Application.DisplayAlerts = False
Dim wb1, wb2 As Workbook
Dim i As Integer
Dim nrow%
Dim arr1()
nrow = Sheet1.Range("l65536").End(xlUp).Row
Set wb1 = ActiveWorkbook
ReDim arr1(3 To nrow)
Workbooks.Open Filename:=Range("p1") & "\" & Range("q1") '打开d:\date\模板
Set wb2 = ActiveWorkbook
For i = 3 To nrow
wb1.Sheets("资料").Activate
arr1(i) = Range("p1") & "\" & i - 2 & "-" & Range("l" & i) & ".xlsx" '定义个数组,存放文件夹保存的位置
Range("A" & i).EntireRow.Copy wb2.Sheets("资料").Range("a3") '统计表的第3-7列复制到模板的第3列
wb2.Sheets("资料").Activate
Range("a1").Select
wb2.SaveCopyAs Filename:=arr1
Next
wb2.Save
wb2.Close
Excel.Application.DisplayAlerts = True
Excel.Application.CutCopyMode = True
Excel.Application.ScreenUpdating = True
End Sub
|
|