Looping and then Consolidating

[Guest]

What I'm doing is looping through all excel files in a folder and then
copying the list in sheet 1 in each file onto a "consolidate" worksheet
Below is my code to date, I'm missing something somewhere, any help would be
great:


Sub SubGetMyData()


Dim objFSO As Scripting.FileSystemObject
Dim objFolder As Scripting.Folder
Dim objSubfolder As Scripting.Folder
Dim objFile As Scripting.File
Dim iRow As Long


iRow = 3
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("c:\My Documents\Career\")
For Each objFile In objFolder.Files
If objFile.Type = "Microsoft Excel Worksheet" Then

Workbooks.Open Filename:=objFolder.Path & "\" & objFile.Name
j = 1
For Each Workbook In Workbooks
Workbook.Worksheets("Sheet1").Cells(i, 2).EntireRow.Copy Destination =
Worksheets("consolidate").Cells(j, 1)
ActiveWorkbook.Close savechanges:=True
iRow = iRow + 1
End If
Next
Next
End Sub

 

[Bob Phillips]

Teresa,

Does this work any better?

I was not sure where i and j came from so I have made some assumptions

Sub SubGetMyData()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim owb As Workbook
Dim j As Long

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("c:\MyTest\")
j = 1
For Each objFile In objFolder.Files
If objFile.Type = "Microsoft Excel Worksheet" Then

Set owb = Workbooks.Open(Filename:=objFolder.Path & "\" &
objFile.Name)
owb.orksheets("Sheet1").Cells(1, 2).EntireRow.Copy
Destination:=Worksheets("consolidate").Cells(j, 1)
j = Worksheets("consolidate").Cells(Rows.Count,
"A").End(xlUp).Row + 1
ActiveWorkbook.Close savechanges:=True
End If
Next
End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[Jim Cone]

Teresa,

This should get you a little closer...
'---------------------------------------------
'Requires a project reference to the "Microsoft Scripting Runtime" (scrrun.dll)
Sub SubGetMyData()
Dim objFSO As Scripting.FileSystemObject
Dim objFolder As Scripting.Folder
Dim objSubfolder As Scripting.Folder
Dim objFile As Scripting.File
Dim iRow As Long

Application.ScreenUpdating = False
iRow = 3
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\My Documents\Career")

For Each objFile In objFolder.Files
If objFile.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open Filename:=objFolder.Path & "\" & objFile.Name
Workbooks(objFile.Name).Worksheets(1).UsedRange.Copy _
Destination:=Workbooks("Consolidate.xls").Worksheets(1).Cells(iRow, 1)
Workbooks(objFile.Name).Close savechanges:=False
iRow = Workbooks("Consolidate.xls").Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 2
End If
Next

Application.ScreenUpdating = True
End Sub
'-------------------------------------------------

Regards,
Jim Cone
San Francisco, USA