new macro

[Scott]

Hi There,

(Please note i have also posted this same question in the Worksheetfunctions
newsgroup)

I have a macro ('GetMyData' see below for code) that goes through a
directory and pulls all relevant details from different excel spreadsheets
and copies the data into 1 spreadsheet call 'totalling'.

i now wish to try and create a new spreadsheet 'statement' which will
collect some info from the spreadsheet called 'totalling' and copy data back
into 'statement'

i am lost on several points and these are as follows:

the field in column 'A' on 'totalling' lists a company name and then fields
b etc contain info about 'A' i want to copy cells 'E' 'F' 'G' into
'statement' and do that for as long as 'A' contains that company name.

any assitance is greatly appreciated, and i would like to thank you all in
advance for any help given.

Regards,

Scott


Sub GetMyData()
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

With ThisWorkbook.Worksheets(1).Range("A1:G1")
.Value = Array("Name", "Contact", "Address", "Suburb", "Date",
"Number", "Amount")
With .Font
.Name = "Arial"
.Size = 16
.Bold = True
End With
.HorizontalAlignment = xlCenter
End With

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("d:\files\spreadsheets\")
For Each objFile In objFolder.Files
If objFile.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open Filename:=objFolder.Path & "\" & objFile.Name
With ActiveWorkbook.Worksheets(1)
ThisWorkbook.Worksheets(1).Cells(iRow, 1).Value =
..Range("A13").Value
ThisWorkbook.Worksheets(1).Cells(iRow, 2).Value =
..Range("A14").Value
ThisWorkbook.Worksheets(1).Cells(iRow, 3).Value =
..Range("A16").Value
ThisWorkbook.Worksheets(1).Cells(iRow, 4).Value =
..Range("A17").Value
ThisWorkbook.Worksheets(1).Cells(iRow, 5).Value =
..Range("F7").Value
ThisWorkbook.Worksheets(1).Cells(iRow, 6).Value =
..Range("F8").Value
ThisWorkbook.Worksheets(1).Cells(iRow, 7).Value =
..Range("F45").Value
End With
ActiveWorkbook.Close savechanges:=False
iRow = iRow + 1
End If
Next

ThisWorkbook.Worksheets(1).Cells(iRow + 1, 7) = "=Sum(G2:G" & (iRow - 1)
& ")"
ThisWorkbook.Worksheets(1).Cells(iRow + 1, 6) = "TOTAL"

ThisWorkbook.Worksheets(1).Cells(iRow + 1, 6).Select
Selection.Font.Bold = True
With Selection.Font
.Name = "Arial"
.Size = 14
End With

ThisWorkbook.Worksheets(1).Cells(iRow + 1, 7).Select
Selection.Font.Bold = True
With Selection.Font
.Name = "Arial"
.Size = 14
End With
Selection.Style = "Currency"

With ThisWorkbook.Worksheets(1).Range("A1:G1").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End With

ThisWorkbook.Worksheets(1).Columns("A:G").EntireColumn.AutoFit

Range("A3").Select
Range("A3:G68").Sort Key1:=Range("A3"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Application.ScreenUpdating = True

End Sub

 

[gocush]

This sounds like your Totalling sheet is a list of invoices for th
month. Then what you want to do is collect all invoices for eac
company for a monthly statement.

An easy way to do this is to use AutoFilter.

Try using the macro recorder to do this:

Select any cell in your dataset
Turn on the recorder.
Click Data|Autofilter.
In col A select a company
Select the entire range
Insert a new worksheet

Turn off the recorder and look at your new code.


If you make a list of all company names, you can add code to your macr
like this:

Dim oCell as range, x as integer,CompanyName as string
x=sheets.count
For each oCell in Range("CompanyNameList")
CompanyName = oCell.value
....use the code that you recorded....

Copy Destination:= sheet(x).range("A2")
x=x+1
next


this should get you started