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("Utility ID")
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("Utility ID")

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