View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
Don Lloyd Don Lloyd is offline
external usenet poster
 
Posts: 119
Default Pointer required

Hi Brian,

My original post was OK for my tests but needs further modification to work
with your data.
The revised code is as follows.

Sub Test()
Dim Indx, IndxCol, DestCell, RwFirst, RwLast, Blank
Dim ColFirst, ColLast
Dim CurrRw, Rnge As Range, Fname

'DATA RELATING TO YOUR DATA BASE - CHANGE ACCORDINGLY
RwFirst = 10 'Change to first row containing your data
ColFirst = 3 'Change to first column of data
ColLast = 20 'change to last column of data
IndxCol = 4 'Change to the column with your Index
DestCell = "A1" 'where the copied data is to be placed
Blank = 2 'The index (from left)of a blank worksheet
'
Application.ScreenUpdating = False
Indx = 0: CurrRw = RwFirst
RwLast = RwFirst
Do
Indx = Indx + 1
Do Until Cells(CurrRw + 1, IndxCol) < Indx
RwLast = RwLast + 1
CurrRw = CurrRw + 1
Loop
Set Rnge = Range(Cells(RwFirst, ColFirst), Cells(RwLast, ColLast))
'copy to the second sheet of master file
Rnge.Copy Sheets(Blank).Range(DestCell)
'this creates a new workbook
Sheets(Blank).Copy
Fname = Indx & ".xls"
ActiveWorkbook.SaveAs Filename:=Fname
ActiveWorkbook.Close
'now back to the master workbook
Sheets(Blank).Cells.ClearContents
RwFirst = RwLast + 1
Loop Until Indx = 3
Application.ScreenUpdating = True
'
End Sub

regards,
Don

"KiwiBrian" wrote in message
...
I have a 2000 row database with one of the columns containing an index
number between 1 and
30.
This is to enable the extraction of all records having the same index

number
into 30 seperate files.
I assume that what I want to find/aquire/write is a script that will

enable
the automatic (in one operation) extraction of the 30 different
mini-databases, saving them in the same folder as the source, and named
1.xls to 30.xls.
Can anyone give me any pointers as to how I might achieve my end

objective?
Thanks
Brian Tozer