PDA

View Full Version : Solved: Looping through workbooks instead of worksheet



Elvis
02-03-2009, 07:15 AM
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
02-03-2009, 09:57 AM
First, I will open the workbooks which I need. Then just add in the line below to your existing code.


Dim WB As WorkBook

For Each WB In WorkBooks
' Put your exisitng code here
Next WB


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

Bob Phillips
02-03-2009, 11:59 AM
Not tested, but this should get you close



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

Elvis
02-04-2009, 05:31 AM
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
02-04-2009, 06:15 AM
It should be



Set wb = Workbooks.Open(Filename)

Elvis
02-04-2009, 07:13 AM
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
02-04-2009, 09:40 AM
See if this cracks it



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

Elvis
02-04-2009, 11:06 AM
OK Great, this works fine now.

Thanks very much for all your help.

Elvis

lucas
02-04-2009, 11:17 AM
Elvis, be sure to mark your thread solved using the thread tools at the top of the page......