Split Range into Multiple Columns VBA

**Admin** · 12-22-2011, 01:33 AM

Hi All,

Here is a sub to split a range into multiple columns.

Code:

Option Explicit

Sub SplitRangeIntoMultipleCols()

    Dim varData, varArrOutput(), rngSource As Range
    Dim j As Long, m As Long, i As Long, n As Long, c As Long
    Dim wksResult   As Worksheet
    
    Set rngSource = Application.InputBox(prompt:="Select the range to convert", Title:="ExcelFox.com", Type:=8)

    If Not rngSource Is Nothing Then
        c = Application.InputBox("How many columns maximum do you want?", Title:="ExcelFox.com", Type:=1)
        If c > 0 Then
            varData = rngSource
            If IsArray(varData) Then
                j = UBound(varData, 1) \ c
                If j * c <> UBound(varData, 1) Then j = j + 1
                ReDim varArrOutput(1 To j, 1 To c * UBound(varData, 2))
                c = 1
                For i = 1 To UBound(varData, 1)
                    n = n + 1
                    For m = 1 To UBound(varData, 2)
                        varArrOutput(n, c + m - 1) = varData(i, m)
                    Next
                    If i Mod j = 0 Then c = c + m - 1: n = 0
                Next
                Application.ScreenUpdating = False
                Set wksResult = Worksheets.Add: wksResult.Name = "Result_"
                wksResult.Range("a2").Resize(j, UBound(varArrOutput, 2)) = varArrOutput
            End If
        End If
    End If
                    
    Application.ScreenUpdating = True
                    
End Sub