简体   繁体   English

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

[英]Excel VBA loop folder and check if Excel file name is equal to worksheet

I'm in need of some enlightment. 我需要一些启示。 I'm trying to match a folder of Excel files with some sheets in an Excel workbook. 我正在尝试将Excel文件的文件夹与Excel工作簿中的某些工作表匹配。 So far, I'm able to read these Excel files names and corresponding sheets and copy to them to sheet1 B1 of my workbook. 到目前为止,我已经能够读取这些Excel文件名和相应的工作表并将其复制到我的工作簿的sheet1 B1中。 After that I create a sheet for every file. 之后,我为每个文件创建一个工作表。

I would like the macro to continue and compare every file in the directory with the sheets I have in my workbook. 我希望该宏继续并将目录中的每个文件与工作簿中的工作表进行比较。 If the sheet name from workbook is equal to filename, than copy file contents (only sheet1 from these files has data). 如果工作簿中的工作表名称等于文件名,则复制文件内容(只有这些文件中的sheet1才有数据)。

This is what I have so far: 这是我到目前为止的内容:

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

untested! 未经测试!

but do you might need something like: 但您可能需要以下内容吗:

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

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM