Hi Shrinivas
Try :
Sub Mtest()
Dim Rng As Range
Dim ws As Worksheet
Dim shname As String
Dim i As Integer
Dim shn As Long
Dim mx As Variant
Dim x As Integer
Dim LR As Long
Dim sPath As String, sFileName As String
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Temp").Delete
Application.DisplayAlerts = True
Set Rng = Sheets("Div").Range("A6:A" & Cells(Rows.Count, 1).End(xlUp).Row)
Set ws2 = Worksheets.Add(After:=Sheets(Sheets.Count))
With ws2
Rng.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("A1"),
unique:=True
.Name = "Temp"
End With
Sheets("Temp").Columns("A").SpecialCells(xlCellTypeBlanks).Delete
shift:=xlShiftUp
LR = Sheets("Temp").Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To LR
Cname = Sheets("Temp").Cells(i, 1)
Set ws2 = Workbooks.Add
mx = Array("Div", "bon", "right")
shn = 1 - LBound(mx)
For x = LBound(mx) To UBound(mx)
Sheets(x + shn).Name = mx(x)
Next x
m = ws2.Name
ThisWorkbook.Activate
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Temp" Then
ws.UsedRange.AutoFilter Field:=1, Criteria1:=Cname
ws.UsedRange.SpecialCells(xlCellTypeVisible).Copy
shname = ws.Name
Application.Goto _
Workbooks(m).Sheets(shname).Cells(1, 1)
ActiveSheet.Paste
ThisWorkbook.Activate
End If
Next ws
ws2.Activate
'Save the new workbook
sPath = ThisWorkbook.Path & "\"
'sPath = "C:\Users\MAHESH\Downloads\Delete\"
sFileName = Cname & ".xls"
Application.DisplayAlerts = False
ws2.SaveAs (sPath & sFileName)
ws2.Close True
ThisWorkbook.Activate
Next i
End Sub
HTH
Mahesh
On Sat, Oct 1, 2011 at 4:34 PM, Chidurala, Shrinivas <
shrinivas.chidur...@citi.com> wrote:
> Dear All,
>
> I have dump file of 3 sheets which contain the data of some clients in each
> sheet, I want to split the files into client wise and also note the client
> name is all sheet is in column A.
>
> Please advise me to create macro. Find attached sample of dump file and
> client file for your reference.
>
> Regards,
> Shrinivas
>
> --
>
> ----------------------------------------------------------------------------------
> Some important links for excel users:
> 1. Follow us on TWITTER for tips tricks and links :
> http://twitter.com/exceldailytip
> 2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
> 3. Excel tutorials at http://www.excel-macros.blogspot.com
> 4. Learn VBA Macros at http://www.quickvba.blogspot.com
> 5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
>
> To post to this group, send email to excel-macros@googlegroups.com
>
> <><><><><><><><><><><><><><><><><><><><><><>
> Like our page on facebook , Just follow below link
> http://www.facebook.com/discussexcel
>
--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Follow us on TWITTER for tips tricks and links :
http://twitter.com/exceldailytip
2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
3. Excel tutorials at http://www.excel-macros.blogspot.com
4. Learn VBA Macros at http://www.quickvba.blogspot.com
5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
<><><><><><><><><><><><><><><><><><><><><><>
Like our page on facebook , Just follow below link
http://www.facebook.com/discussexcel
