Can some one help on Saving multiple excel files from one excel data file

[Damodaram]

Hi anyone,

Can some one help me to save multiple excel files from one excel database.

I have three tabs in one excel file.
I have around 500 rows in 3rd tab with 35 columns data..
in 20 column, i have persons names. if i see the names it comes around 26 unique names out of 500.
So is there any way i need to separate 26 files for 26 unique persons with their related data in 3rd tab. but i also need to retain tab 1 & 2. and same format to be retained. please help me out with the issue.

Thanks,
Damodaram Eddala

[westconn1]

this would be simple to do using ADO with SQL queries, if that method suits you

try like

Dim cn As Connection, rs As Recordset, rs2 As Recordset, cel As Range
Dim newbook As Workbook
Set cn = New Connection
Set rs = New Recordset
Set rs2 = New Recordset
With cn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties=""Excel 8.0;hdr=no;IMEX=1;"""
'"Extended Properties=Excel 8.0;"
.Open
End With
If rs.State Then rs.Close
Sql = "select distinct f20 from [sheet3$]"
rs.Open Sql, cn, adOpenStatic, adLockReadOnly
Do Until rs.EOF
If Not IsNull(rs(0)) Then
Sql = "select * from [sheet3$] where f20 ='" & rs(0) & "'"
rs2.Open Sql, cn, adOpenStatic, adLockReadOnly
Set newbook = Workbooks.Add
With newbook
.Sheets(1).Range("a1").CopyFromRecordset rs2
ThisWorkbook.Sheets(2).Copy .Sheets(1)
ThisWorkbook.Sheets(1).Copy .Sheets(1)
.SaveAs ThisWorkbook.Path & "\" & rs(0) & ".xls"
.Close
End With
End If
rs.MoveNext
Loopchange sheet names and column indexes as required
change workbook naming and path to suit
requires a reference to ADO (microsoft activex data objects)

i semi tested the code, but needs full checking of results