Question

我正在尝试编写一些CBA代码，以使我的工作更轻松。实际上，我想打开两个工作簿，工作簿1 和工作簿2 。

然后我需要将workbook2（例如C103:C107）的某些单元格复制到workbook 1（E41:E45）并将workbook1保存为新工作簿名为X1.xlsm。

从D103:D107复制（workbook2）并复制到（E41:E45）workbook1并保存为新的X2.xlsm。

(E103:E107) (workbook 2) ---(E41:E45) ( Workbook1)，保存为x3.xlsm ......

同样的事情循环遍历Worbook 2的列。

但以下宏不起作用：

Sub TADDEnter()
Dim wbk1 As Workbook
Dim wbk2 As Workbook
Dim activeWB As Workbook
Dim FilePath1 As String
Dim FilePath2 As String

FilePath1 = "T:\L'Oreal\83113035 - Project Beauty\TOM\Deliverables\Tables\TADD\Copy of TADD Uploads (002).xlsx"
FilePath2 = "T:\L'Oreal\83113035 - Project Beauty\TOM\Deliverables\Tables\TADD\TADD CSV template.xlsm"
Set wbk1 = Application.Workbooks.Open(FilePath2)
Set wbk2 = Application.Workbooks.Open(FilePath1)
Set activeWB = Application.ActiveWorkbook
For icol = 3 To 33
    wbk1.Sheets("DATA MEASURES FORM").Copy
    Workbooks.Add
    Range("A1").PasteSpecial
    wbk2.Sheets("LOreal").Range(wbk2.Sheets("LOreal").Cells(103, icol), wbk2.Sheets("LOreal").Cells(107, icol)).Copy Destination:=activeWB.Sheets("DATA MEASURES FORM").Range("E41:E45")
    activeWB.SaveAs Filename:= _
        "T:\L'Oreal\83113035 - Project Beauty\TOM\Deliverables\Tables\TADD\TADD_CSV_" & wbk2.Sheets("LOreal").Cells(147, icol).Value & ".xlsm"
     activeWB.Close
    Application.CutCopyMode = False
   Next icol
End Sub

Answer 1

尝试在创建新工作簿后将其设置为activeWB。

Sub TADDEnter()

Dim wbk1 As Workbook 'source_A
Dim wbk2 As Workbook 'source_B
Dim activeWB As Workbook 'target
Dim FilePath1 As String
Dim FilePath2 As String

FilePath1 = "T:\L'Oreal\83113035 - Project Beauty\TOM\Deliverables\Tables\TADD\Copy of TADD Uploads (002).xlsx"
FilePath2 = "T:\L'Oreal\83113035 - Project Beauty\TOM\Deliverables\Tables\TADD\TADD CSV template.xlsm"
Set wbk1 = Application.Workbooks.Open(FilePath1)
Set wbk2 = Application.Workbooks.Open(FilePath2)

For icol = 3 To 33
    wbk1.Sheets("DATA MEASURES FORM").Copy 'copy sheet and create a new workbook

    Set activeWB = Application.ActiveWorkbook 'set the new workbook as activeWB
    wbk2.Sheets("LOreal").Range(wbk2.Sheets("LOreal").Cells(103, icol), wbk2.Sheets("LOreal").Cells(107, icol)).Copy
    activeWB.Sheets("DATA MEASURES FORM").Range("E41:E45").PasteSpecial

    activeWB.SaveAs Filename:="X" & icol - 2, FileFormat:=52 '52 = xlsm
    activeWB.Close

    Application.CutCopyMode = False
Next icol

End Sub

VBA循环工作打开两个工作簿并保存为新工作簿

1 个答案: