Sub Data_cleanup()
Dim a As Variant, b As Variant, bits1 As Variant, bits2 As Variant, bits3 As Variant, bits4 As Variant, bits5 As Variant, bits6 As Variant, bits7 As Variant, bits8 As Variant, bits9 As Variant, bits10 As Variant, bits11 As Variant, bits12 As Variant, bits13 As Variant, bits14 As Variant, bits15 As Variant, bits16 As Variant, bits17 As Variant
Dim i As Long, j As Long, k As Long, n As Long, R As Long
a = Range("A1:Q" & Range("A" & Rows.Count).End(xlUp).Row).Value
ReDim b(1 To Rows.Count, 1 To UBound(a, 2))
For i = 1 To UBound(a)
bits1 = Split(a(i, 2) & ",", ",")
bits2 = Split(a(i, 3) & ",", ",")
bits3 = Split(a(i, 4) & ",", ",")
bits4 = Split(a(i, 5) & ",", ",")
bits5 = Split(a(i, 6) & ",", ",")
bits6 = Split(a(i, 7) & ",", ",")
bits7 = Split(a(i, 8) & ",", ",")
bits8 = Split(a(i, 9) & ",", ",")
bits9 = Split(a(i, 10) & ",", ",")
bits10 = Split(a(i, 11) & ",", ",")
bits11 = Split(a(i, 12) & ",", ",")
bits12 = Split(a(i, 13) & ",", ",")
bits13 = Split(a(i, 14) & ",", ",")
bits14 = Split(a(i, 15) & ",", ",")
bits15 = Split(a(i, 16) & ",", ",")
bits16 = Split(a(i, 17) & ",", ",")
n = UBound(bits1)
If UBound(bits2) > n Then
n = UBound(bits2)
ReDim Preserve bits1(0 To n)
Else
ReDim Preserve bits2(0 To UBound(bits1))
End If
For j = 0 To n - 1
R = R + 1
b(R, 1) = a(i, 1): b(R, 2) = bits1(j): b(R, 3) = bits2(j): b(R, 4) = bits3(j): b(R, 5) = bits4(j): b(R, 6) = bits5(j): b(R, 7) = bits6(j): b(R, 8) = bits7(j): b(R, 9) = bits8(j): b(R, 10) = bits9(j): b(R, 11) = bits10(j): b(R, 12) = bits11(j): b(R, 13) = bits12(j): b(R, 14) = bits13(j): b(R, 15) = bits14(j): b(R, 16) = bits15(j): b(R, 17) = bits16(j)
Next j
Next i
Range("S1:AI1").Resize(R).Value = b
End Sub