VBA 루핑 작업을 두 통합 문서를 열고 새 통합 문서로 저장

Question

내 작업을 쉽게하기 위해 일부 CBA 코드를 작성하려고합니다. 사실, 두 통합 문서 통합 문서 1 및 통합 문서 2을 열고 싶습니다.

은 그 때 나는 X1.xlsm라는 새 통합 문서로 workbook1를 특정 세포가 workbook 1 (E41:E45)에 (예를 들어 C103:C107) workbook2을 형성 복사하고 저장해야합니다.

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 

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