Move data from master in another sheets

[Pirvu Vali]

Hi guys. i have a workbook with a master. I want if in col A is meet i, move raw in Sheet i, if p in sheet P, if f in sheet f, if l in sheet l. But i want to move with header "Range A1-M8".

[Pirvu Vali]

some help, pleasE?

[Sintek]

This will give you an idea...Cleaned up your sheet...

Option Explicit

Sub Move_Info_To_Sheets()
Dim Val, ws As Worksheet, i As Long, lr As Long
Application.ScreenUpdating = False
With Sheet1
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    .Range(.Cells(2, 1), .Cells(Rows.Count, 1)).AdvancedFilter xlFilterCopy, , .Range("P1"), True
    With .Range("P1").CurrentRegion:  Val = .Value:  .Clear:  End With
    For i = 2 To UBound(Val)
        With .Cells(1).CurrentRegion
            .AutoFilter 1, Val(i, 1)
            If Evaluate("ISREF('" & Val(i, 1) & "'!A1)") = False Then
                Set ws = Sheets.Add(After:=Sheets(1))
                ws.Name = Val(i, 1)
            End If
            .SpecialCells(12).Copy Sheets(Val(i, 1)).Range("A1")
            .AutoFilter
            With Sheets(Val(i, 1))
                .Rows(1).RowHeight = 50
                .Range("A1:M1").Columns.AutoFit
            End With
        End With
    Next i
End With
Sheet1.Activate
Application.ScreenUpdating = True
End Sub

[Pirvu Vali]

is working perfect, but how can to copy format?

[Sintek]

Meaning...

[Pirvu Vali]

i want to copy some formats like in masters

[Pirvu Vali]

or there may be another solution ?

[Sintek]

What are you wanting...Explain in detail...
Upload a sample file with your expected results...This way we can see exactly what you require...

want to move with header "Range A1-M8".

EDIT
Try this...

[Pirvu Vali]

i upload a sample file .

[Sintek]

See Post 8 edit Upload...

If that is not what you want then perhaps someone else can better understand your requirement...

[jindon]

Sub test()
    Dim a, i As Long, dic As Object, temp As Boolean
    Application.ScreenUpdating = False
    temp = Application.CopyObjectsWithCells
    Application.CopyObjectsWithCells = True
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    With Sheets("sheet1")
        With .Range("a9", .Range("a" & Rows.Count).End(xlUp))
            .Value = Application.Trim(.Value)
            a = .Value
            For i = 2 To UBound(a, 1)
                If (a(i, 1) <> "") * (Not dic.exists(a(i, 1))) Then
                    dic(a(i, 1)) = Empty
                    If Not Evaluate("isref('" & a(i, 1) & "'!a1)") Then
                        Sheets.Add(Sheets(Sheets.Count)).Name = a(i, 1)
                    End If
                    Sheets(a(i, 1)).Cells.Delete
                    .Parent.Cells.Copy
                    Sheets(a(i, 1)).Cells(1).PasteSpecial xlPasteColumnWidths
                    .Parent.Rows("1:9").Copy Sheets(a(i, 1)).Cells(1)
                    .AutoFilter 1, a(i, 1)
                    .EntireRow.Copy Sheets(a(i, 1)).Range("a9")
                    Application.Goto Sheets(a(i, 1)).Cells(1)
                    .AutoFilter
                End If
            Next
        End With
    End With
    Application.CopyObjectsWithCells = temp
    Application.ScreenUpdating = True
End Sub

[jindon]

You are welcome.