çok teşekkürler arkadaşlar, bende bir yöntem buldum çalıştı..
şöyle soldan 3 basamak alıyorum farklı bir sutuna orada sıralıyorum genişleterek hop sıralanıyor. emeğinize sağlık.
Not, bulana kadar karnım çatladı. emeğinize sağlık yinede eksik olmayın....

Secret35 nickli arkadaşımızın yöntemi;

Sub Macro1()
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="-", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
    Columns("A:A").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A1:B1" & lastRow)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "=RC[-3] &"" - ""& RC[-2]"
    Range("D1").Select
    Selection.AutoFill Destination:=Range("D1:D1" & lastRow), Type:=xlFillDefault
    Range("D1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("B:B").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
End Sub