Ordinamento di due colonne non adiacenti senza influire su altre colonne

Ho due colonne diverse su Excel. Voglio creare uno script che ordinerà la colonna F, (hanno un'intestazione) e ordinerà la colonna B in base a dove ha funzionato l'ordinamento della colonna F. (Tuttavia, senza influire su altre colonne!)

Quindi se ho

    ColB       ColF
 1. Cat        2
 2. Mouse      1
 3. Dog        3

Il tipo mi darà

    ColB       ColF
 1. Mouse        1
 2. Cat          2
 3. Dog          3

Come posso fare questo? Ho provato a registrare una macro, (o semplicemente ho provato a ordinarlo con le due colonne cliccate e il pulsante di ordinamento), ma ho un errore che dice "Il comando non può essere eseguito con più selezioni, fai clic su un singolo intervallo e riprova"

Ho il sospetto che ci debba essere un modo migliore per realizzare qualunque cosa tu voglia fare ordinando queste colonne, ma qui c'è una soluzione VBA che farà esattamente quello che hai chiesto. Attenzione, questo codice presuppone che non ci siano celle vuote negli intervalli che si desidera ordinare. Si prega di lasciare un commento se questo è un problema, perché sarà abbastanza facile da risolvere.

Sub nonadjacentsort()
Dim rng1 As Range, rng2 As Range, rngTmp As Range, s1 As Worksheet, tmpS As Worksheet
Dim tmpArr1() As Variant, tmpArr2() As Variant
Dim i As Long
Set s1 = ActiveSheet
'Set Ranges to sort.  This assumes there are no blanks in your data.
Set rng1 = s1.Range("B1", Range("B1").End(xlDown))
Set rng2 = s1.Range("F1", Range("F1").End(xlDown))
'Load first column into temporary array
tmpArr1 = rng1.Value
'Load data into larger array that will hold both columns
ReDim tmpArr2(1 To UBound(tmpArr1, 1), 1 To 2) As Variant
For i = 1 To UBound(tmpArr1, 1)
    tmpArr2(i, 1) = tmpArr1(i, 1)
Next i
'Load second column into temporary array
Erase tmpArr1
tmpArr1 = rng2.Value
'Load second column into larger array
For i = 1 To UBound(tmpArr1, 1)
    tmpArr2(i, 2) = tmpArr1(i, 1)
Next i
Erase tmpArr1
'Add new sheet and print two columns there together.
Application.ScreenUpdating = False
Set tmpS = Sheets.Add
Set rngTmp = tmpS.Range("A1").Resize(UBound(tmpArr2, 1), 2)
rngTmp = tmpArr2
Erase tmpArr2
'Sort by second column (Column F of original data)
rngTmp.Sort rngTmp.Cells(1, 2), xlAscending, Header:=xlYes
'Load sorted data into array and then overwrite columns on original data
tmpArr1 = rngTmp.Columns(1).Value
rng1 = tmpArr1
Erase tmpArr1
tmpArr1 = rngTmp.Columns(2).Value
rng2 = tmpArr1
Erase tmpArr1
'Delete temporary sheet.
Application.DisplayAlerts = False
tmpS.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub