Solved: Looping through workbooks instead of worksheet

[Elvis]

Hi,

I have the code below which loops through all sheets in a given workbook and consolidates the data in a summary sheet for the ranges defined in the code.

However I need to change this so that it loops through all workbooks in a given folder and copies the information from the first sheet of each workbook.

Would this be easy to change?

Thanks,

Elvis
----------------------------

Sub Summarisesheets2() 'works - returns the value in cells below in every sheet in workbook
Dim SummarySheet As String
Sheets.Add before:=Sheets(1) 'inserts sheet
SummarySheet = ActiveSheet.Name
For i = 2 To ActiveWorkbook.Sheets.Count
Sheets(SummarySheet).Cells(i - 1, 2).Value = Sheets(i).Name 'inserts the name of indivdual sheet
Sheets(SummarySheet).Cells(i - 1, 3).Value = Sheets(i).Range("d8").Value ' Spend
Sheets(SummarySheet).Cells(i - 1, 7).Value = Sheets(i).Range("m25").Value 'Revenue ROI
Sheets(SummarySheet).Cells(i - 1, 8).Value = Sheets(i).Range("f25").Value ' Max Rev ROI
Sheets(SummarySheet).Cells(i - 1, 9).Value = Sheets(i).Range("J25").Value 'Min Rev ROI
Sheets(SummarySheet).Cells(i - 1, 10).Value = Sheets(i).Range("m22").Value 'Min Rev ROI
Sheets(SummarySheet).Cells(i - 1, 11).Value = Sheets(i).Range("m23").Value 'incremental Vol
Sheets(SummarySheet).Cells(i - 1, 12).Value = Sheets(i).Range("m24").Value 'Incremental Revenue
Sheets(SummarySheet).Cells(i - 1, 13).Value = Sheets(i).Range("F27").Value 'LT ROI Low
Sheets(SummarySheet).Cells(i - 1, 14).Value = Sheets(i).Range("J27").Value 'LT ROI High
Sheets(SummarySheet).Cells(i - 1, 15).Value = Sheets(i).Range("M27").Value 'LT ROI Avg
'column headings

Next i

End Sub

[X10A]

First, I will open the workbooks which I need. Then just add in the line below to your existing code.

[VBA]
Dim WB As WorkBook

For Each WB In WorkBooks
' Put your exisitng code here
Next WB
[/VBA]

Please make sure you backup your work before using this solution.
Regards.

[Bob Phillips]

Not tested, but this should get you close

[vba]

Public Sub Test()
Dim Filename As String
Dim NextRow As Long

NextRow = 1
ActiveWorkbook.Sheets.Add before:=Sheets(1) 'inserts sheet
Filename = Dir("C:\My Documents\Forms\*.xls")
Do While Filename <> ""

Call Summarisesheets(Filename, NextRow)
Filename = Dir
Loop

End Sub
Sub Summarisesheets2(Filename As String, _
ByRef NextRow As Long)
'works - returns the value in cells below in every sheet in workbook
Dim SummarySheet As String
Dim wb As Workbook

With ActiveWorkbook

Set wb = Workbooks(Filename).Open

.Worksheets(1).Cells(NextRow, 2).Value = wb.Worksheets(1).Name 'inserts the name of indivdual sheet
.Worksheets(1).Cells(NextRow, 3).Value = wb.Worksheets(1).Range("D8").Value ' Spend
.Worksheets(1).Cells(NextRow, 7).Value = wb.Worksheets(1).Range("M25").Value 'Revenue ROI
.Worksheets(1).Cells(NextRow, 8).Value = wb.Worksheets(1).Range("F25").Value ' Max Rev ROI
.Worksheets(1).Cells(NextRow, 9).Value = wb.Worksheets(1).Range("J25").Value 'Min Rev ROI
.Worksheets(1).Cells(NextRow, 10).Value = wb.Worksheets(1).Range("M22").Value 'Min Rev ROI
.Worksheets(1).Cells(NextRow, 11).Value = wb.Worksheets(1).Range("M23").Value 'incremental Vol
.Worksheets(1).Cells(NextRow, 12).Value = wb.Worksheets(1).Range("M24").Value 'Incremental Revenue
.Worksheets(1).Cells(NextRow, 13).Value = wb.Worksheets(1).Range("F27").Value 'LT ROI Low
.Worksheets(1).Cells(NextRow, 14).Value = wb.Worksheets(1).Range("J27").Value 'LT ROI High
.Worksheets(1).Cells(NextRow, 15).Value = wb.Worksheets(1).Range("M27").Value 'LT ROI Avg

NextRow = NextRow + 1

wb.Close savechanges:=False
End With

End Sub
[/vba]

[Elvis]

XLD,

Thanks for the code. I have tried it out and am getting the following run-time error: subscript out of range.

Debugging takes me to the following line in the summarisesheets2 sub:

Set wb = Workbooks(Filename).Open

Any ideas?

Thanks,

Elvis

[Bob Phillips]

It should be

[vba]

Set wb = Workbooks.Open(Filename)
[/vba]

[Elvis]

Hi,

I changed the code but it still not working. Now getting a run time error of 1004 on the same line of code: "'DSF2009' could not be found"

DSF2009 is one of the files in the folder that I'm trying to summarise. If I remove this file from the folder, then I get the same error message listing another file in the folder.

Elvis.

[Bob Phillips]

See if this cracks it

[vba]

Public Sub Test()
CONST FILEPATH As String = "C:\My Documents\Forms\"
Dim Filename As String
Dim NextRow As Long

NextRow = 1
ActiveWorkbook.Sheets.Add before:=Sheets(1) 'inserts sheet
Filename = Dir(FILEPATH & "*.xls")
Do While Filename <> ""

Call Summarisesheets( FILEPATH & Filename, NextRow)
Filename = Dir
Loop

End Sub
Sub Summarisesheets2(Filename As String, _
ByRef NextRow As Long)
'works - returns the value in cells below in every sheet in workbook
Dim SummarySheet As String
Dim wb As Workbook

With ActiveWorkbook

Set wb = Workbooks(Filename).Open

.Worksheets(1).Cells(NextRow, 2).Value = wb.Worksheets(1).Name 'inserts the name of indivdual sheet
.Worksheets(1).Cells(NextRow, 3).Value = wb.Worksheets(1).Range("D8").Value ' Spend
.Worksheets(1).Cells(NextRow, 7).Value = wb.Worksheets(1).Range("M25").Value 'Revenue ROI
.Worksheets(1).Cells(NextRow, 8).Value = wb.Worksheets(1).Range("F25").Value ' Max Rev ROI
.Worksheets(1).Cells(NextRow, 9).Value = wb.Worksheets(1).Range("J25").Value 'Min Rev ROI
.Worksheets(1).Cells(NextRow, 10).Value = wb.Worksheets(1).Range("M22").Value 'Min Rev ROI
.Worksheets(1).Cells(NextRow, 11).Value = wb.Worksheets(1).Range("M23").Value 'incremental Vol
.Worksheets(1).Cells(NextRow, 12).Value = wb.Worksheets(1).Range("M24").Value 'Incremental Revenue
.Worksheets(1).Cells(NextRow, 13).Value = wb.Worksheets(1).Range("F27").Value 'LT ROI Low
.Worksheets(1).Cells(NextRow, 14).Value = wb.Worksheets(1).Range("J27").Value 'LT ROI High
.Worksheets(1).Cells(NextRow, 15).Value = wb.Worksheets(1).Range("M27").Value 'LT ROI Avg

NextRow = NextRow + 1

wb.Close savechanges:=False
End With

End Sub
[/vba]

[Elvis]

OK Great, this works fine now.

Thanks very much for all your help.

Elvis

[lucas]

Elvis, be sure to mark your thread solved using the thread tools at the top of the page......