Segregate data in different sheets with specific name

[bmbalamurali]

Hi All,

Here is my need. also i tried it on my own, but as a newbie in VBA more debug messages are coming than the code line i coded.

Need:

Have a excel with name and addresses
Name is repeated and addresses vary
I need the each similar names and its addresses to be cut and pasted in a separate sheet with the sheet name of the name what we are cut and paste.

Example:

Balamurali & address in proceeding columns
Repeated & address in proceeding column
cena & address in proceeding columns
Repeated & address in proceeding column

Balamurali and his address should come in new sheet with sheet name of "Balamurali"
Cena and his address should come in new sheet with sheet name of "Cena"

Note: heading row must be also come in each sheet

Have attached excel sheet with sample data and also you can find my codes there (Its totally a mess, hence i didn't pasted here in post)

Kindly help.

Thanks for your time.

[nilem]

Hi bmbalamurali,

take a look at the solution in this thread. Probably, it is suitable for you.

[anil kmr]

Hi bmbalamurli,

Please use below mentioned code,

Sub segg()
Dim sh As Worksheet
Dim rng As Range
Dim cell As Range
Set sh = ThisWorkbook.Sheets("master")
sh.Range("A1:A" & sh.Cells(Rows.Count, "A").End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, Copytorange:=sh.Range("J1"), Unique:=True
Set rng = sh.Range("J2:J" & sh.Cells(Rows.Count, "J").End(xlUp).Row)
For Each cell In rng
sh.Range("A1:g1").AutoFilter Field:=1, Criteria1:=cell.Value, visibleDropdown:=False
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = cell.Value
sh.Range("A1:g" & sh.Cells(Rows.Count, "g").End(xlUp).Row).Copy Sheets(Sheets.Count).Cells(1, 1)
Next cell

End Sub

I think it would be useful for you, if any query please let me know.

Thanks
Anil

[anil kmr]

Hi bmbalamurli,

Please use below mentioned code,

Sub segg()
Dim sh As Worksheet
Dim rng As Range
Dim cell As Range
Set sh = ThisWorkbook.Sheets("master")
sh.Range("A1:A" & sh.Cells(Rows.Count, "A").End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, Copytorange:=sh.Range("J1"), Unique:=True
Set rng = sh.Range("J2:J" & sh.Cells(Rows.Count, "J").End(xlUp).Row)
For Each cell In rng
sh.Range("A1:g1").AutoFilter Field:=1, Criteria1:=cell.Value, visibleDropdown:=False
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = cell.Value
sh.Range("A1:g" & sh.Cells(Rows.Count, "g").End(xlUp).Row).Copy Sheets(Sheets.Count).Cells(1, 1)
Next cell

End Sub

I think it would be useful for you, if any query please let me know.

Thanks
Anil

[bmbalamurali]

Hi Anil,

Thanks it works perfect.

Your first post itself a great one. Thanks a lot friend.

[bmbalamurali]

Hi Anil,

Can u pls explain what mistake am doing this code.

sorry to extend this post...

what i trying to do is.... in column A has stringslike "^Report..." , "Report...." and "Run..."
i used a For each loop and if the activecell contains entire row gets deleted.


when i run the macro, "^Report...." and "Run..." gets deleted....
another "report doesn't delete. (I i run the macro again, at that time the remaining "Report///" text row gets deleted...)
I don't know why it happens and what mistake i have done.... Please give me an answer... Thanks.

Please Login or Register  to view this content.

[anil kmr]

Hi,

please delete the highlighted from the code you will get the desired result.......


Sub test()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ms As Worksheet: Set ms = wb.Sheets("Master")

Dim cell As Range
Dim rng As Range

Set rng = ms.Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)

For Each cell In rng.Cells
If cell.Value Like "*Report*" Or cell.Value Like "*Run*" Then
cell.EntireRow.Delete
End If
Next cell

End Sub

[bmbalamurali]

Hi Anil,

Great help...Thanks for your kindness.....all works well...

Pardon me....Can you do one more quick help...post which i will solve the thread....

Tha macro you gave to segregate data in to seperate sheet, i need a code that would segregate the data in to each seperate workbook and save it in name of the unique filter value.

Waiting fir your reply.

Thanks in advance.

[bmbalamurali]

Done it by myself... proud of me