T
teresa
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
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