VBA循环使用两个工作簿打开并保存为新工作簿答案

【问题标题】：VBA looping work with two workbook open and save as a new workbookVBA循环使用两个工作簿打开并保存为新工作簿
【发布时间】：2017-12-21 01:47:50
【问题描述】：

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

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

从 workbook2 复制 (D103:D107) 并复制到 (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

【问题讨论】：

它以什么方式“不起作用”？给我们一个线索。老鼠跑了？显示器炸了？
你得到什么错误，当你点击调试时它在哪一行突出显示？
添加新工作簿后尝试设置 activeWB。目前，您的 activeWB 是 wbk2。

标签： excel vba loops

【解决方案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

【讨论】：