[英]Find and List Sheets for All Workbooks in a Directory- Excel, VBA
I am currently trying to compile a list of all the names of the Worksheets from multiple Workbooks in a directory. 我目前正在尝试从目录中的多个工作簿编译工作表的所有名称的列表。 So far, I have found and edited some code (see below) that will give me the desired result, but just for one Workbook at a time.
到目前为止,我已经找到并编辑了一些代码(请参见下文),这些代码将为我提供所需的结果,但一次只提供一本工作簿。 There are easily 400 workbooks I need to pull from, and I'm trying to work a bit smarter rather than harder on this one.
我需要轻松提取400本工作簿,而我正在努力使这一工作更聪明而不是更努力。 Unfortunately, these Workbooks could be stored in any folder or subfolder in the directory, with the only consistency being that they are the only .xlsm files.
不幸的是,这些工作簿可以存储在目录中的任何文件夹或子文件夹中,唯一的一致性是它们是唯一的.xlsm文件。 Would there be a way to do this and have each Workbook's Worksheet titles listed in separate columns?
有没有办法做到这一点,并在单独的列中列出每个工作簿的工作表标题? Any help greatly appreciated!!
任何帮助,不胜感激!
Sub ListSheets()
'enter my directory
Workbooks.Open Filename:="path"
Dim ws As Worksheet
Dim i As Integer
With ThisWorkbook.Worksheets("Sheet1")
.Range("a:a").ClearContents
For Each ws In ActiveWorkbook.Worksheets
i = i + 1
.Range("a" & i) = ws.Name
Next ws
End With
'Enter my workbook below
Workbooks("").Close True
End Sub
Try following sub. 尝试下面的子。 Hope it will help you.
希望对您有帮助。
Sub EachSHinEachBook()
Dim FolderNme As String
FileType = "*.xls*" 'The file type to search for
OutputRow = 2 'The first row of the active sheet to start writing to
filepath = "C:\MyExcelFiles\" 'The folder to search
ThisWorkbook.ActiveSheet.Range("A" & OutputRow).Activate
OutputRow = OutputRow + 1
Curr_File = Dir(filepath & FileType)
Do Until Curr_File = ""
Set FldrWkbk = Workbooks.Open(filepath & Curr_File, False, True)
ThisWorkbook.ActiveSheet.Range("A" & OutputRow) = Curr_File
ThisWorkbook.ActiveSheet.Range("B" & OutputRow).ClearContents 'Clear any previous values
OutputRow = OutputRow + 1
For Each Sht In FldrWkbk.Sheets
ThisWorkbook.ActiveSheet.Range("B" & OutputRow) = Sht.Name
ThisWorkbook.ActiveSheet.Range("A" & OutputRow).ClearContents 'Clear any previous values
OutputRow = OutputRow + 1
Next Sht
FldrWkbk.Close SaveChanges:=False
Curr_File = Dir
Loop
Set FldrWkbk = Nothing
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.