Thread
:
list excel wookbooks and worksheets
View Single Post
#
2
Posted to microsoft.public.excel.programming
Claus Busch
external usenet poster
Posts: 3,872
list excel wookbooks and worksheets
Hi,
Am Wed, 7 Oct 2015 08:15:15 -0700 (PDT) schrieb
:
Is there a way to utilize a bit of VBA code that will create a list of excel workbooks in a directory with all the corresponding worksheets in an adjacent column with the contents of a specific cell, say C1, next to that?
try:
Sub Test()
Dim objFSO As Object, objFolder As Object, objFile As Object
Dim varHeader As Variant, varOut() As Variant
Dim i As Long, n As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Modify your path
Const myPath = "E:\Excel_NG\AktuelleProjekte\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(myPath)
varHeader = Array("Workbook", "Sheets", "C1")
With ActiveSheet
.Range("A1:C1") = varHeader
.Range("A1:C1").Font.Bold = True
For Each objFile In objFolder.Files
If InStr(objFile.Name, ".xls") Then
.Cells(Rows.Count, 2).End(xlUp)(2).Offset(, -1) =
objFile.Name
Workbooks.Open myPath & objFile.Name
n = 0
ReDim Preserve varOut(1, Worksheets.Count - 1)
For i = 1 To ActiveWorkbook.Worksheets.Count
varOut(0, n) = Worksheets(i).Name
varOut(1, n) = Worksheets(i).Range("C1").Value
n = n + 1
Next
ActiveWorkbook.Close savechanges:=False
.Cells(Rows.Count, 2).End(xlUp)(2).Resize(n, 2) _
= Application.Transpose(varOut)
End If
Next
.Columns("A:C").AutoFit
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional
Reply With Quote
Claus Busch
View Public Profile
Find all posts by Claus Busch