
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
    
    Dim Dest As Range
    Set Dest = Sheets(2).[A1]
    
    Dest.CurrentRegion.ClearContents
    
    Range([A1], [A65536].End(xlUp)).Resize(, 2).AdvancedFilter _
        Action:=xlFilterCopy, _
        CopyToRange:=Dest, _
        Unique:=True
    
    With Dest.CurrentRegion
        .Sort Key1:=Dest
        .EntireColumn.AutoFit
    End With
End Sub

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 1