[英]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.