I have updated the functionality of my earlier post to only copy over unique values, then I added a sort on the values copied over.
Option Compare Text
'Copy a column from one Table to another
Sub copyUnique()
'Delete current values prior to paste if values exist
If Application.WorksheetFunction.CountA(Range("Table2[[Column1]]")) <> 0 _
Then Range("Table2[[Column1]]").Delete
'Advanced filter for unique entries only
Range("Table1[[#All],[Column3]]").AdvancedFilter Action:=xlFilterInPlace, _
Unique:=True
'Select desired column to copy with destination option
Range("Table1[[Column3]]").Copy _
Destination:=Range("Table2[[Column1]]")
'Remove Filter After Copy
Range("Table1[[#Headers],[Column3]]").Select
ActiveSheet.ShowAllData
'Sort a table column A to Z
Worksheets("Sheet2").ListObjects("Column1").Sort.SortFields.Clear
Worksheets("Sheet2").ListObjects("Column1").Sort.SortFields.Add _
Key:=Range("Table2[[Column1]]"), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
With Worksheets("Sheet2").ListObjects("Column1").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
I am not certain if this is the best way to do it but the code is snappy and works for my needs.