求助，用vba实现自动批量复制并修改保存文件

代码在文件模块里，或把以下代码粘到模块里

Sub 写入数据()

wbpath = ThisWorkbook.Path &"\"

模板文件地址 = wbpath &"模板文件" &"\"

到文件夹 = wbpath &"生成表格复制到该文件夹" &"\"

my_file = Dir(模板文件地址)

Do While my_file <>""

Workbooks.Open Filename:=模板文件地址 &my_file

With ThisWorkbook

  data_row = .ActiveSheet.Range("A" &Rows.Count).End(xlUp).Row

  For i = 2 To data_row

    If Val(.ActiveSheet.Cells(i, 4)) = Val(Split(ActiveWorkbook.Name, ".")(0)) Then

      ActiveWorkbook.ActiveSheet.Range("F2") = .ActiveSheet.Cells(i, 3).Value

      ActiveWorkbook.SaveAs Filename:=到文件夹 &.ActiveSheet.Range("B" &i) &".xlsx"

      ActiveWorkbook.Close False

    End If

  Next i

End With

my_file = Dir

Loop

End Sub

SUB 宏1()

DIM T, WB AS WORKBOOK

FOR EACH T IN ("B.XLS","C.XLS","D.XLS")

ON ERROR RESUME NEXT

SET WB=NOTHING

SET WB=WORKBOOKS(T)

ON ERROR GOTO 0

IF WB IS NOTHING THEN SET WB=WORKBOOKS.OPEN(T)

WORKBBOKS("A.XLS").SHEETS("计划表").USEDRANGE.COPY WB.SHEETS("计划表").CELLS(1,1)

NEXT T

END SUB

1、开发工具——VB。

2、输入代码：Sub 复制表() Dim MyBook1 As Workbook  Set MyBook1 = Workbooks.Open("C:\Users\Administrator\Desktop\工作表1.xls")  Sheets("移动表").Select   Sheets("移动表").Copy Before:=Workbooks( _ "工作表2.xls").Sheets(1)MyBook1.CloseEnd Sub。

3、开发工具——宏。

4、执行——复制表。

5、如图，复制完成。

---