T
teresa
The code looks through files ina folder and then dumps the figures in a
worksheet,
then at bottom sums cells, the looping & dumping works fine,
doesn't seem to sum, help is much appreciated, thanks
Sub SubGetMyData3c()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim owb As Workbook
Dim j, k As Long
Dim RngToCopy, Rng2ToCopy As Range
Dim intNumRows As Integer, c As Variant, 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
With Range("b" & intNumRows + 1)
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium
End With
For Each c In Range("b1", "b" & intNumRows)
lngCellTotal = lngCellTotal + c.Value
Next
Range("b" & intNumRows + 1) = lngCellTotal
End If
Next objFile
End Sub
worksheet,
then at bottom sums cells, the looping & dumping works fine,
doesn't seem to sum, help is much appreciated, thanks
Sub SubGetMyData3c()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim owb As Workbook
Dim j, k As Long
Dim RngToCopy, Rng2ToCopy As Range
Dim intNumRows As Integer, c As Variant, 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
With Range("b" & intNumRows + 1)
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium
End With
For Each c In Range("b1", "b" & intNumRows)
lngCellTotal = lngCellTotal + c.Value
Next
Range("b" & intNumRows + 1) = lngCellTotal
End If
Next objFile
End Sub