Excel VBAループフォルダとExcelファイル名がワークシートと等しいかどうかを確認してください

Question

私はいくつかのenlightmentが必要です。 Excelブックの一部のシートとExcelファイルのフォルダを一致させようとしています。これまでのところ、私はこれらのExcelファイル名と対応するシートを読んで、自分のワークブックのsheet1B1にコピーすることができました。その後、私はすべてのファイルのシートを作成します。

私はマクロを続けて、ディレクトリ内のすべてのファイルをブック内のシートと比較したいと思います。ブックのシート名がファイル名と等しい場合は、ファイルの内容をコピーします（これらのファイルのsheet1のみがデータを持ちます）。

これは私がこれまで持っているものです。

Sub readme() 

Dim directory As String, fileName As String, sheet As Worksheet, i As Integer, j As Integer 

Application.ScreenUpdating = False 
directory = "D:\Claro Chile\Report_sem_formulas\" 
fileName = Dir(directory & "*.xl??") 

     Do While fileName <> "" 

      i = i + 1 
      j = 2 
      Cells(i, 1) = fileName 
      Workbooks.Open (directory & fileName) 

        For Each sheet In Workbooks(fileName).Worksheets 

        Workbooks("Report Status v1.xlsm").Worksheets(1).Cells(i, j).Value = sheet.Name 

        j = j + 1 

     Next sheet 

    Workbooks(fileName).Close 
    fileName = Dir() 

Loop 

Application.ScreenUpdating = True 
Call create_sheets_starting_from_B1 

End Sub 

Sub create_sheets_starting_from_B1() 

Dim MyCell As Range, MyRange As Range 

Set MyRange = Sheets("Summary").Range("B1") 
Set MyRange = Range(MyRange, MyRange.End(xlDown)) 

    For Each MyCell In MyRange 
     Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet 
     Sheets(Sheets.Count).Name = MyCell.Value 'renames the new worksheet 
    Next MyCell 

Sheets("Summary").Move Before:=Sheets(1) 

End Sub 

Answer 1

テストされていません！

しかし、あなたのような何かが必要な場合がありますん：、

Sub sheetCompare() 
    Dim i As Integer 
    Dim mDirs As String 
    Dim path As String 
    Dim OutFile As Variant, SrcFile As Variant 
    Dim file As Variant 

    OutFile = ActiveWorkbook.Name 
    mDirs = "c:\" 'your dir here 
    file = Dir(mDirs) 
    While (file <> "") 
     path = mDirs + file 
     Workbooks.Open (path) 
     SrcFile = ActiveWorkbook.Name 

     For i = 1 To Workbooks(OutFile).Sheets.Count 
      If file = Workbooks(OutFile).Sheets(i).Name Then 
       'copy logic 
      End If 
     Next i 
     Workbooks(file).Close (False) 
     file = Dir 
    Wend 
End Sub