首页 文章

Excel VBA循环文件夹并检查Excel文件名是否等于工作表

提问于
浏览
0

我'm in need of some enlightment. I'尝试将Excel文件的文件夹与Excel工作簿中的某些工作表匹配 . 到目前为止,我能够读取这些Excel文件名和相应的工作表,并将它们复制到我的工作簿的 sheet1 B1 . 之后,我为每个文件创建一个工作表 .

我希望宏继续并将目录中的每个文件与工作簿中的工作表进行比较 . 如果工作簿中的工作表名称等于文件名,则复制文件内容(这些文件中只有 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

1 回答

  • 0

    未经测试!

    但你可能需要这样的东西:

    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
    

相关问题