Sorting table to new sheets in the same worksheet..

[erdow]

Hi to all,

I have a report about 5.000 rows long and it starst from 3. row (there is a headline at 2. row)
There are another vba code to get region names to column A and after that i need another vba code to copy every region data to another sheet on the same workbook.
My exact data is very long, its form A to KP and 5.000 rows.
What i need is , When i run the vba code, first it must sort them(i meant a:kp) by column A (i meant by region) then copy them according to their region name to new sheets (sheet name must be same as region name) (and main page must stay unchanged with all data sorted by region names) (every sheet must have header i meant headline, which is 2. row for hole report)
Is it possible?
Thanks.

 

[mumps]

Try:

Sub CreateSheets()
    Application.ScreenUpdating = False
    Dim i As Long, v As Variant, ws As Worksheet
    Set ws = ActiveSheet
    v = ws.Range("A3", ws.Range("A" & ws.Rows.Count).End(xlUp)).Value
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(v, 1)
            If Not .Exists(v(i, 1)) Then
                .Add v(i, 1), Nothing
                With ws.Range("A2")
                    .CurrentRegion.AutoFilter 1, v(i, 1)
                    ws.AutoFilter.Range.Copy
                    If Not Evaluate("isref('" & v(i, 1) & "'!A1)") Then
                       Sheets.Add(After:=Sheets(Sheets.Count)).Name = v(i, 1)
                       ActiveSheet.Range("A1").PasteSpecial
                    End If
                End With
            End If
        Next i
    End With
    ws.Range("A2").AutoFilter
    Application.ScreenUpdating = True
End Sub

 

[erdow]

Try:

Sub CreateSheets()
    Application.ScreenUpdating = False
    Dim i As Long, v As Variant, ws As Worksheet
    Set ws = ActiveSheet
    v = ws.Range("A3", ws.Range("A" & ws.Rows.Count).End(xlUp)).Value
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(v, 1)
            If Not .Exists(v(i, 1)) Then
                .Add v(i, 1), Nothing
                With ws.Range("A2")
                    .CurrentRegion.AutoFilter 1, v(i, 1)
                    ws.AutoFilter.Range.Copy
                    If Not Evaluate("isref('" & v(i, 1) & "'!A1)") Then
                       Sheets.Add(After:=Sheets(Sheets.Count)).Name = v(i, 1)
                       ActiveSheet.Range("A1").PasteSpecial
                    End If
                End With
            End If
        Next i
    End With
    ws.Range("A2").AutoFilter
    Application.ScreenUpdating = True
End Sub

Thank you so much for your fast solution mumps.
It works great.

 

[mumps]

You are very welcome.