複数の固定セルを新しいものにする

Question

私はExcel VBAで非常に新しく、複数のExcelワークブックからのデータを新しいものにフェッチする際に質問があります。
ここで説明します：
1.メインフォルダ（"C:\desktop\Main\"）には複数のサブフォルダがあります（ここではfolder A1とfolder A2を例として取り上げます）。 "C:\desktop\Main\A1\" & "C:\desktop\Main\A2\"
各サブフォルダには、複数のExcelがあります。たとえば
：folder A1では、2つのフォルダ（​​3210と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）のうちの1つを例にとります。
A1は上記のように見えます。
A2には、固定されたセルに異なる番号/文字の同じテンプレートが含まれています。
3.私は次のようにそれらを取得したい：
すべてのExcelは、上記の例のようにテンプレートが固定されています。
複数の優れたフォルダが複数ある場合、どうすればいいですか？ ありがとうございます。

Answer 1

これは、メインフォルダの下にいくつのレベルのサブフォルダがあるかを知るかどうかによって異なります。これが予測可能である場合、例えば。あなたは次の2つのレベル（メイン> 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