여러 셀에서 고정 셀 가져 오기

Question

저는 Excel VBA에서 매우 새로 우며, 여러 Excel 통합 문서의 데이터를 가져 오지 않는 질문에 대한 질문이 있습니다.
여기에서 설명 할 것입니다 :
1. 메인 폴더 ("C:\desktop\Main\")에는 하위 폴더가 여러 개 있습니다 (여기에 folder A1과 folder A2을 예로 들어 있습니다). "C:\desktop\Main\A1\" & "C:\desktop\Main\A2\"
각 하위 폴더에는 여러 Excel이 있습니다. 예를 들어
: folder A1에서, 2 개 폴더 (A1-2015.xlsx 및 A1-2016.xlsx) folder A2에서 "C:\desktop\Main\A1\A1-2015.xlsx" 및 "C:\desktop\Main\A1\A1-2016.xlsx"
가, 내가 새 Excel 통합 문서에이 탁월합니다 세포를 얻으려면
3 개 폴더 (A2-2015.xlsx, A2-2016.xlsx 및 A2-2017.xlsx)이있다 .
2. 따라서, item1에 대한 설명을 기반으로합니다. A1 (A1-2016.xlsx) 중 하나와 A2 (A2-2017.xlsx) 중 하나를 예로 들겠습니다.
A1은 위와 같습니다.
A2에는 고정 된 셀에 다른 숫자/문자가있는 동일한 템플릿이 들어 있습니다.
3. 다음과 같이 가져오고 싶습니다.
위의 예와 같이 모든 템플릿이 고정되어 있습니다.
여러 폴더에 여러 개의 Excel이있는 경우 어떻게합니까? 감사합니다.

Answer 1

주 폴더 아래에 몇 개의 하위 폴더가 있는지 알고 있는지 여부에 따라 다릅니다. 예상 가능한 경우 예 : 당신은 다음의 두 가지 레벨 (Main> A1)만이 있다는 것을 알고 있습니다. 파일 시스템 개체 (도구> 참조 메뉴에서 Microsoft Scripting Runtime에 대한 참조를 추가해야 함)를 사용하려고합니다.

추가했으면 아래 코드를 사용하여 작업을 수행하십시오 (주로 파일에서 병합하려는 정보를 주로 추측하므로 약간 조정해야 할 수도 있음) :

Sub Merge_Files() 
    Dim FSO As New FileSystemObject 
    Dim Main_Fold As Folder, Sub_1 As Folder 
    Dim Fil As File 
    Dim Main_WB As Workbook, New_WB As Workbook 
    Dim X As Integer, Y As Integer 
    Set Main_WB = ActiveWorkbook 
    Set Main_Fold = FSO.GetFolder("C:\Desktop\Main\") 'Replace this with a reference to your actual main folder. 
    For Each Sub_1 In Main_Fold.subFolders 
     For Each Fil In Sub_1.Files 
      Set New_WB = Workbooks.Open(Fil.Path) 
      For X = 2 To 1000 
       If Main_WB.Sheets(1).Range("A" & X).Value = "" Then 
         Main_WB.Sheets(1).Range("A" & X).Value = New_WB.Sheets(1).Range("C2").Value 
         Exit For 
       End If 
       If Main_WB.Sheets(1).Range("A" & X).Value = New_WB.Sheets(1).Range("C2").Value Then Exit For 
      Next X 
      For Y = 2 To 5 
       Main_WB.Sheets(1).Cells(X, Y) = New_WB.Sheets(1).Range("C" & (Y + 1)).Value 
      Next Y 
      For Y = 4 To 9 
       If Y = 6 Then Y = 7 
       If Y < 6 Then 
         Main_WB.Sheets(1).Cells(X, Y + 2) = New_WB.Sheets(1).Cells(9, Y) 
        Else 
         Main_WB.Sheets(1).Cells(X, Y + 1) = New_WB.Sheets(1).Cells(9, Y) 
       End If 
      Next Y 
      Main_WB.Sheets(1).Range("K" & X).Value = New_WB.Sheets(1).Range("K21").Value 
      New_WB.Close SaveChanges:=False 
     Next Fil 
     Next Sub_1 
End Sub