Třeba
Sub Copy()
Dim POCET As Long
Dim RADEK As Long
Dim wsDATA As Worksheet
Set wsDATA = Worksheets("List1")
Application.ScreenUpdating = False
RADEK = wsDATA.Cells(Rows.Count, "B").End(xlUp).Row - 1
If RADEK > 0 Then wsDATA.Range("B2").Resize(RADEK, 1).ClearContents
POCET = WorksheetFunction.Match("nic", wsDATA.Range("A:A"), 0) - 2
wsDATA.Range("B2").Resize(POCET, 1).Value = wsDATA.Range("A2").Resize(POCET, 1).Value
wsDATA.Range("B1:B" & POCET + 1).Sort key1:=wsDATA.Range("B1"), order1:=xlAscending, Header:=xlYes
Application.ScreenUpdating = True
End Sub
Ještě úprava, před kopírováním nejprve smazat stará data a odstranění probliknutí.
citovat