auto add column

[Scott]

Hi there,

i am hoping you can help.

i hav the following code (see below) which takes numbers from multiple
spreadsheets etc (and it works well) however i am trying to do 1 last thing
and that is as follows:

The number that is placed in cell (iRow, 6) i would like to have tallied at
the end of the script, so for instance if there are 70 numbers then i would
like to leave a space and have a tally appear just underneath it in Cell 'f'
Line 72. Is this easy to do?

Thanking you in advance

Scott


Sub SubGetMyData()
Application.ScreenUpdating = False

Dim objFSO As Scripting.FileSystemObject
Dim objFolder As Scripting.Folder
Dim objSubfolder As Scripting.Folder
Dim objFile As Scripting.File
Dim iRow As Long

iRow = 3
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("e:\scott\Sotek\Invoices\")
For Each objFile In objFolder.Files
If objFile.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open Filename:=objFolder.Path & "\" & objFile.Name
With ActiveWorkbook.Worksheets(1)
.Range("A13").Copy
Destination:=ThisWorkbook.Worksheets(1).Cells(iRow, 1)
.Range("A14").Copy
Destination:=ThisWorkbook.Worksheets(1).Cells(iRow, 2)
.Range("A15").Copy
Destination:=ThisWorkbook.Worksheets(1).Cells(iRow, 3)
.Range("F7").Copy
Destination:=ThisWorkbook.Worksheets(1).Cells(iRow, 4)
.Range("F8").Copy
Destination:=ThisWorkbook.Worksheets(1).Cells(iRow, 5)
ThisWorkbook.Worksheets(1).Cells(iRow, 6).Value =
..Range("f45").Value
End With
ActiveWorkbook.Close savechanges:=False
iRow = iRow + 1
End If
Next

Application.ScreenUpdating = True
End Sub

 

[Dave Peterson]

How about:

Option Explicit
Sub SubGetMyData()
Application.ScreenUpdating = False

Dim objFSO As Scripting.FileSystemObject
Dim objFolder As Scripting.Folder
Dim objSubfolder As Scripting.Folder
Dim objFile As Scripting.File
Dim iRow As Long

iRow = 3
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Set objFolder = objFSO.getfolder("e:\scott\Sotek\Invoices\")
Set objFolder = objFSO.getfolder("C:\my documents\excel\test\")
For Each objFile In objFolder.Files
If objFile.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open Filename:=objFolder.Path & "\" & objFile.Name
With ActiveWorkbook.Worksheets(1)
.Range("A13").Copy _
Destination:=ThisWorkbook.Worksheets(1).Cells(iRow, 1)
.Range("A14").Copy _
Destination:=ThisWorkbook.Worksheets(1).Cells(iRow, 2)
.Range("A15").Copy _
Destination:=ThisWorkbook.Worksheets(1).Cells(iRow, 3)
.Range("F7").Copy _
Destination:=ThisWorkbook.Worksheets(1).Cells(iRow, 4)
.Range("F8").Copy _
Destination:=ThisWorkbook.Worksheets(1).Cells(iRow, 5)
ThisWorkbook.Worksheets(1).Cells(iRow, 6).Value _
= .Range("f45").Value
End With
ActiveWorkbook.Close savechanges:=False
iRow = iRow + 1
End If
Next

With ThisWorkbook.Worksheets(1)
.Cells(iRow + 1, 6).Formula _
= "=sum(" & .Range(.Cells(3, 6), _
.Cells(iRow - 1, 6)).Address(0, 0) & ")"
End With

Application.ScreenUpdating = True
End Sub

I noticed that you changed that last copy (F45) to just an assignment. Just
curious: Is there some reason you didn't adjust the others, too?

ThisWorkbook.Worksheets(1).Cells(iRow, 1).value = .range("A13").value
(and so forth)

 

[Dave Peterson]

I'd guess that you dropped this line:

With ThisWorkbook.Worksheets(1)

But your formula looks fine to me. (Maybe even easier to understand!!!)