Looping down list and each time copying to another worksheet

  • Thread starter Thread starter mattri
  • Start date Start date
M

mattri

Hi all,
I'm a newbie to VBA and need a solution to the following problem if
possible.

I have a worksheet that summarises another using sumproducts etc and
displays info for one account at a time whereas the main report displays
all accounts.

I need some vba code that will loop down the list of account numbers on
the main worksheet and each time do the following:

1) Copy account number to summary worksheet
2) Copy summary worksheet to new workbook and name workbook by account
number
3) Copy paste value for worksheet so that it has no links.
4) Repeat for each account number.

It sounds like a very complicated macro would be needed - is this
possible?
 
Dim sh as Worksheet, sh1 as Worksheet
Dim rng as Range
Dim sPath as String
sPath = Activeworkbook.Path
if right(sPath,1) <> "\" then sPath = sPath & "\"
With Worksheets("Accounts")
set rng = .Range(.Cells(1,1),.Cells(rows.count,1).End(xlup))
End With
set sh = Worksheets("Summary")
for each cell in rng
sh.Range("A1").Value = cell.Value
sh.Copy
set sh1 = Activeworkbook.Worksheets(1)
sh1.Cells.copy
sh1.Cells.PasteSpecial xlValues
sh1.Parent.SaveAs sPath & _
sh1.Range("A1") & ".xls", xlworkbookNormal
sh1.close savechanges:=False
Next
 
The best way to loop down a list is to define the first
column of the list as a range and pass through it using
the For Each...Next command. For each row in the list, you
can call a separate sub which will can do all the nitty
gritty work each time. E.g.

Sub Main_Subroutine
Dim DataRange As Range, MyCell As Range

Set DataRange = Range(Cells(1,1), _
Cells(Range("A65536").End(xlUp).Row,1))

For Each MyCell In DataRange
Call Summarise_Account(Cells(MyCell.Row, 1).Value)
Next MyCell

End Sub

Next, the tasks you need to perform,
1) Copy account number to summary worksheet

This is quite simple, e.g.

Sub Summarise_Account(Account_number)

Windows("Summary Worksheet").Activate
Range("A1") = Account_number

2) Copy summary worksheet to new workbook and name
workbook by account number

Cells.Copy
Workbooks.Add
ActiveSheet.Paste Cells

' Name the workbook when you save it to reduce code - see
' a few lines below

3) Copy paste value for worksheet so that it has no links

Cells.Copy
Cells.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

4) Repeat for each account number.
This is done by the For Each loop described earlier

All that is left is to save the file and end the sub:

ActiveWorkbook.Close SaveChanges:=True, _
Filename:="<path of folder>\" & Account_number

End Sub
 
Back
Top