Do you have both the Utility ID and GAMES sheets in the same workbook ?
If so, any others ?

Just those two. How do I post the code that I changed? It's the same code you gave me in the beginning just changed the name from Utility to GAMES in both places.


Ahh, got it....



Option Explicit

Sub Eight_To_Two_And_Back()
Dim src As Worksheet, dest As Worksheet
Dim r As Long, c As Long, x As Long
Dim ray As Variant

Set src = Sheets("GAMES")
Set dest = Sheets("ScratchPad")

dest.UsedRange.Delete

r = 1
For c = 1 To 10 Step 3
With src
ray = Range(.Cells(1, c), .Cells(Rows.Count, c + 1).End(xlUp)).Value
x = UBound(ray, 1)
End With
With dest
.Cells(r, 1).Resize(x, 2) = ray
r = r + x
End With
Next c
'sort
dest.Sort.SortFields.Clear
dest.Sort.SortFields.Add Key:=Range("A1:A" & Rows.Count).End(xlUp), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With dest.Sort
.SetRange Range(dest.Range("A1"), dest.Range("B" & Rows.Count).End(xlUp))
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Call BackToEight

End Sub

Private Sub BackToEight()
Dim i As Long, lr As Long
Dim r As Long, c As Long
Dim src As Worksheet, dest As Worksheet

Set src = Sheets("ScratchPad")
Set dest = Sheets("GAMES")

dest.UsedRange.ClearContents

lr = src.Range("A" & Rows.Count).End(xlUp).Row
r = 1
c = 1

For i = 1 To lr Step 50
dest.Cells(r, c).Resize(50, 2).Value = src.Cells(i, 1).Resize(50, 2).Value
c = c + 3
If c = 13 Then
r = r + 50
c = 1
End If
Next i

End Sub