wrote:
Can someone think of an elegant way to loop through the
creation of a range that creates the following permutations

First, it appears that you are interested in combinations, not permuations.
COMBIN(6,k), for k=6,5,4,3,2,1, tells you how many combinations to expect in
each group. You will see that you are missing some combinations.

Second, your Range syntax is invalid. I presume you mean
Range("A1:A100,B1:B100,C1:C100,D1:D100,E1:E100,F1: F100"), for example.

Third, it is unclear whether you simply want some output. (I use
Debug.Print to write to the Immediate Window.) Or if you actually want to
set a Range variable xRng. (See the Set statement for that purpose.)

See the macro below.

The Debug.Print output is a little more than what you ask for. I presume
that you know how to customize it to your needs exactly. Press ctrl+G to
see the output in the Immediate Window. The form of the output is:

COMBIN(6,6) = 1
01: xRng = Range("A1:A100,B1:B100,C1:C100,D1:D100,E1:E100,F1: F100")
COMBIN(6,5) = 6
01: xRng = Range("A1:A100,B1:B100,C1:C100,D1:D100,E1:E100")
02: xRng = Range("A1:A100,B1:B100,C1:C100,D1:D100,F1:F100")
....etc...

The macro....

Option Base 1
Option Explicit

Sub combinKofN()
Dim rngs
Dim nRngs As Long, maxCombin As Long, nCombin As Long
Dim nSelect As Long, i As Long, j As Long
Dim r As String
Dim xRng As Range

rngs = Array("A1:A100", "B1:B100", "C1:C100", "D1:D100", "E1:E100",
"F1:F100")
nRngs = UBound(rngs)

For nSelect = nRngs To 1 Step -1
maxCombin = WorksheetFunction.Combin(nRngs, nSelect)
Debug.Print "COMBIN(" & nRngs & "," & nSelect & ") = " & maxCombin

ReDim idx(1 To nSelect) As Long
For i = 1 To nSelect: idx(i) = i: Next

nCombin = 0
Do
' generate next combination
nCombin = nCombin + 1
r = rngs(idx(1))
For i = 2 To nSelect
r = r & "," & rngs(idx(i))
Next
Set xRng = Range(r)
' ...perhaps you want to use xRng for some purpose here...
Debug.Print Format(nCombin, "00") & _
": xRng = Range(""" & xRng.Address(False, False) & """)"
If nCombin = maxCombin Then Exit Do

' next combination index
i = nSelect: j = 0
While idx(i) = nRngs - j
i = i - 1: j = j + 1
Wend
idx(i) = idx(i) + 1
For j = i + 1 To nSelect
idx(j) = idx(j - 1) + 1
Next
Loop
Next

End Sub