View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Jim Cone Jim Cone is offline
external usenet poster
 
Posts: 3,290
Default Looping and then Consolidating

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.Co py _
Destination:=Workbooks("Consolidate.xls").Workshee ts(1).Cells(iRow, 1)
Workbooks(objFile.Name).Close savechanges:=False
iRow = Workbooks("Consolidate.xls").Worksheets(1).Cells(R ows.Count, 1).End(xlUp).Row + 2
End If
Next

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

Regards,
Jim Cone
San Francisco, USA


"teresa" wrote in message
...
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