Your code looks like it should only be copying the firstrow of those worksheets.

Sub SubGetMyData3()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim owb As Workbook
Dim j As Long
dim RngToCopy as range

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\My Documents\Career")

j = 1
For Each objFile In objFolder.Files
If objFile.Type = "Microsoft Excel Worksheet" Then
Set owb = Workbooks.Open(Filename:=objFolder.Path _
& "\" & objFile.Name)
with owb.Worksheets("Sheet1")
set rngtocopy = .range("b1:B" _
& .cells(.rows.count,"B").end(xlup).row)
end with

rngtocopy.entireRow.Copy _
Destination:=Worksheets("consolidate").Cells(j, 1)

j = Worksheets("consolidate") _
.Cells(Rows.Count, "A").End(xlUp).Row + 1
owb.Close savechanges:=false 'why true????
End If
Next objFile
End Sub

teresa wrote:

I am writing code which
loops through the files in a folder,
points at sheet 1 of each file,
copies all the non-empty cells in column B of each sheet 1 (and the rows),
pastes this to consolidate worksheet.
MY CODE IS FINE - ONLY PROBLEM IS THAT ITS NOT COPYING ALL ROWS

Sub SubGetMyData3()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim owb As Workbook
Dim i, j As Long

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\My Documents\Career")
i = 1
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.Worksheets("Sheet1").Cells(i, 2).EntireRow.Copy
Destination:=Worksheets("consolidate").Cells(j, 1)
i = owb.Worksheets("sheet1").Cells(Rows.Count, "A").Row + 1
j = Worksheets("consolidate").Cells(Rows.Count,
"A").End(xlUp).Row + 1
ActiveWorkbook.Close savechanges:=True
End If
Next
End Sub

--

Dave Peterson