View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Claus Busch Claus Busch is offline
external usenet poster
 
Posts: 3,872
Default 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