Advertisement
Guest User

Untitled

a guest
Jun 19th, 2019
71
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.06 KB | None | 0 0
  1. Column A
  2. 1
  3. 2
  4. 3
  5. 4
  6. 5
  7. 1
  8. 1
  9. 2
  10. 3
  11.  
  12. 1 2 3
  13. 4 5 1
  14. 1 2 3
  15.  
  16. =INDIRECT(ADDRESS((ROW($A1)-1)*3+COLUMN(A1),1))
  17.  
  18. Option Explicit
  19.  
  20. Sub movetocolumns()
  21. Dim i As Integer, iRow As Integer
  22. Dim arrSource As Variant
  23.  
  24. 'Set the first row
  25. iRow = 1
  26.  
  27. With ActiveWorkbook.Worksheets("Sheet1")
  28. 'get the data into an array from the first column
  29. arrSource = Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
  30.  
  31. 'parse every value of the array and add the data to the next column
  32. For i = 1 To (UBound(arrSource) - UBound(arrSource) Mod 3) Step 3
  33. .Cells(iRow, 2) = arrSource(i, 1)
  34. .Cells(iRow, 3) = arrSource(i + 1, 1)
  35. .Cells(iRow, 4) = arrSource(i + 2, 1)
  36. iRow = iRow + 1
  37. Next i
  38. 'add the remaining values
  39. Select Case UBound(arrSource) Mod 3
  40. Case 1 'one item to add
  41. .Cells(iRow, 2) = arrSource(i, 1)
  42. Case 2 'still two items to add
  43. .Cells(iRow, 2) = arrSource(i, 1)
  44. .Cells(iRow, 3) = arrSource(i + 1, 1)
  45. Case Else 'nothing to add
  46. End Select
  47. End With
  48. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement