Not Copying All Rows
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 |
Not Copying All Rows
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 |
Not Copying All Rows
You don't give many clues do you?
Perhaps? Sub SubGetMyData3() Dim objFSO As Object Dim objFolder As Object Dim objFile As Object Dim owb As Workbook Dim i As Long, 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) i = owb.Worksheets("sheet1").Cells(Rows.Count, "A").Row + 1 owb.Worksheets("Sheet1").Cells(1, 2).Resize(i, 1).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) "teresa" wrote in message ... 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 |
All times are GMT +1. The time now is 05:59 PM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com