View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Teresa Teresa is offline
external usenet poster
 
Posts: 169
Default Looping & Dumping

My Objective: Loop through workbooks in a Folder, then point to "Proposals"
worksheet in each workbook, then dump entries into "Proposals05" worksheet in
current workbook.
The code works if
Proposals in 1st wks has "2"
Proposals in 2nd wks has "1"
Then proposals 05:
2
1

However, if:
Proposals in 1st wks has "2" and "122"
Proposals in 2nd wks has "1" and "111"
Then proposals 05:
2
1
111

instead of all 4 entries, my code below requires slight tweaking, any help
is appreciated


Sub SubGetMyData3d()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim owb As Workbook
Dim j As Long
Dim RngToCopy, Rng2ToCopy As Range
Dim intNumRows As Integer, c As Range, lngCellTotal As Long

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

j = 1: k = 1: l = 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("Proposals")
Set RngToCopy = .Range("B1:B" _
& .Cells(.Rows.Count, "B").End(xlUp).Row)
End With

RngToCopy.EntireRow.Copy _
Destination:=Worksheets("Proposals05").Cells(j, 1)

j = Worksheets("Proposals05") _
.Cells(Rows.Count, "A").End(xlUp).Row + 1

intNumRows = Cells(50, "B").End(xlUp).Row
End If
Next objFile

For Each c In Worksheets("Proposals05").Range("B1:B" & intNumRows)
lngCellTotal = lngCellTotal + c.Value
Next

'With Worksheets("Proposals05").Range("B" & intNumRows + 1)
' .Borders(xlEdgeLeft).Weight = xlMedium
' .Borders(xlEdgeTop).Weight = xlMedium
' .Value = lngCellTotal
'End With

End Sub