Assign the name to the sheet of the region selected not sheet1, sheet2 etc.

[geniusufo007]

in the attachment, when i choose a region from the drop down and then click on the shortcut created in the sheet, it extracts the data into a new sheet of the region selected,

REQUIRED: when I run the macro it must assign the newly created sheet name of the region selected.

[Sintek]

Change

Sheets.Add

to

Sheets.Add.Name = Sheet4.Range("L2")

[Winon]

@ sintek,

Hi my Vriend,

Jy sal eers 'n kontrole kode moet byvoeg om te bevestig dat die Blad nie alreeds bestaan nie.

Regards.

[Mumps1]

Copy and paste this macro into the worksheet code module. Do the following: right click the tab for your "extract on a new sheet" sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Make e selection in L2.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("L2")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Range("A3:J" & LastRow).AutoFilter Field:=3, Criteria1:=Target
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = Target.Value
    Range("A4:J" & LastRow).SpecialCells(xlCellTypeVisible).Copy Sheets(Target.Value).Cells(1, 1)
    Sheets("extract on a new sheet").ShowAllData
    Application.ScreenUpdating = True
End Sub

[Winon]

@ Mumps1,

And what will happen if the Sheet to be created already exists?

Regards.

[Sintek]

@ Winon

Hi daar ou mater...Long time no hear....
Not sure if OP would require....This surely would mean that the info would change all the time and he would have to copy to nextrow...


Edit...A workaround ?

Option Explicit
Sub Region_Wise_Data()
Dim ws As Worksheet, exists As Boolean, nRow As Long
exists = True
Application.ScreenUpdating = False
With Sheet4
    With .Range("A3:J" & .Cells(Rows.Count, "J").End(xlUp).Row)
        .AutoFilter
        .AutoFilter Field:=3, Criteria1:=Sheet4.Range("L2")
        .SpecialCells(xlCellTypeVisible).Copy
    End With
    If Not Evaluate("ISREF('" & [L2] & "'!L2)") Then exists = False
    If exists = False Then
        Sheets.Add.Name = .Range("L2")
        ActiveSheet.Paste
    Else
        MsgBox "Sheet exists, Info will be copied to next available row", vbInformation, ""
        With Sheets(Sheet4.Range("L2").Value)
            nRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
            .Range("A" & nRow).PasteSpecial xlPasteValues
        End With
    End If
    .Activate
    .ShowAllData
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

[Winon]

@ sintek,

Now that is more like how I got to know you. Much better Coding solution!

Groete,

W

[Sintek]

oops...omitted red in above lol

[Mumps1]

@Winon: I just followed the code in the file attached to Post #1. If geniusufo007 has a problem with the sheet already existing, I can easily modify the macro I suggested to take care of the problem. I believe that a Worksheet_Change event is probably the most efficient way to handle the original request.
@geniusufo007: Please let me know how it works out and if there is a possibilty that the sheet already exists.

[geniusufo007]

thanks ALL specially Mr. sintek for your code

[Sintek]

Glad I could contribute...Tx for rep +

[Winon]

@ sintek,

Heck, you were one ahead of me, as I was going to try and solve this issue for the OP.

Well done!

Mooi bly,

W.