Hi jomili,
try this
Sub ertert()
Dim r As Range, adr$
With Columns(4)
Set r = .Find("B.1.11", LookIn:=xlValues, lookat:=xlWhole)
If Not r Is Nothing Then
adr = r.Address
Do
With Range(r, r.End(xlDown))
With .Offset(, 1).Resize(.Rows.Count - 1) ', 14)
.Offset(, 14).FormulaR1C1 = "=RIGHT(RC[-14],4)&LEFT(RC[-14],2)"
' .Resize(, 15).Select
.Resize(, 15).Sort Key1:=.Cells(1, 15), Order1:=xlAscending
End With
End With
Set r = .FindNext(r)
Loop While r.Address <> adr
End If
End With
Columns(19).ClearContents
End Sub
Bookmarks