Macro to Automate Saving

R

Rich

Hi,

Current Manual Process for Sales Data by Branch is:-

Open Workbook A (List of all data by operative with branch code in column a,
operative in B, with the remaing columns containing all the data.)

Open B

Type the branch code in a cell, vlookups then pull all the data for that
branch by operator.

That bit I'm happy with.

That file is then copied and paste specialled in a new workbook, which is
saved with the branchcode as a file name.

I'd love a Macro which works through a list of branch codes, pulls the data
from wookbook A by vlookup, then pastes the values to a vew workbook which
it saves with the branchcode as the file name.

Can anyone suggest a macro to do this ?
 
R

Rich

Ardus Petus said:
It would help a lot if you could post some sample data of Workbook A, or
better still, upload it to http://cjoint.com and post back the link.

TIA

If I've done it OK, the sample data is here:-

http://cjoint.com/?frqFibMWfC

In that small sample, the second workbook would lookup the data from ytg567,
then I'd save it under filename ytg567.xls.

I want to automate working through the branch list, looking up the data and
saving as branch name.
 
A

Ardus Petus

Here is your macro.

See example: http://cjoint.com/?ftkyKVoGnc

HTH
--
AP

'-------------
Option Explicit

Sub SaveBranches()

Dim rBranch As Range
Dim lBranchCount As Long

' Create list of unique Branch codes
Range("A1:A9").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("I1"), Unique:=True
' Check list size
lBranchCount = Range("I1").End(xlDown).Row - 1
If lBranchCount = Rows.Count - 1 Then
MsgBox "Empty Branch list"
Exit Sub
End If
' Loop thru branches
For Each rBranch In Range("I2").Resize(lBranchCount)
' Filter data pertaining to current branch
Range("A1:G1").AutoFilter Field:=1, Criteria1:=rBranch.Value
' Copy filtered data
Range("A1").CurrentRegion.Copy
' Create new workbook
Workbooks.Add
' Paste data, formats & col width
Range("A1").PasteSpecial Paste:=xlPasteAll
' Save workbook
With ActiveWorkbook
Application.DisplayAlerts = False
.SaveAs _
Filename:=ThisWorkbook.Path & "\" & rBranch.Value & ".xls"
Application.DisplayAlerts = True
.Close
End With
' Get back to data workbook
ThisWorkbook.Activate
Next rBranch
' Clean up
ActiveSheet.AutoFilterMode = False
Range("I1").Resize(lBranchCount + 1).ClearContents

End Sub
'----------
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top