Hello Dave,

Sub pair_them()
Dim r As Range, rSource As Range, rDest As Range
Dim i As Long
Dim v

Set rSource = Sheets("Sheet1").Range("B3")
Set rDest = Sheets("Sheet2").Range("B3")

Set r = Range(rSource, rSource.End(xlDown))

Range(rDest, rDest.Offset(0, 1).End(xlDown)).ClearContents

For Each v In VBUniqRandInt(r.Count, r.Count)
rDest.Offset(Int(i / 2), i Mod 2) = r(v)
i = i + 1
Next v

End Sub

Change source and destination cells if you like.

My UDF VBUniqRandInt you will find he
http://www.sulprobil.com/html/uniqrandint.html

Regards,
Bernd