Split a large column of cells into chunks of 1k comma delimited

[Skie]

Hi all, having a bit of a brain freeze at the moment but dont want to do this manually if I can avoid it as I'll have to do this regularly.

Basically I have a column of 40k numbers that I need to split into chunks of a thousand so I can toss them into another report.

EG
A
10243
415111
35472
468746
9994400

Into
10243,415111,35472,468746,9994400

Preferably the 1k comma'd chunks would be deposited into column B

Many thanks!

 

[Ruddles]

Something along these lines should do the job:-

[FONT=Fixedsys]Option Explicit[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]Public Sub ReColumnData()[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]  Const LinesPerCell As Long = [COLOR=red]1000
[/COLOR]  
  Dim ws As Worksheet
  Dim iRow As Long
  Dim iLastRow As Long
  Dim iOutRow As Long
  Dim rRange As Range
  Dim vCell() As Variant
  Dim sCell As String
  
  Set ws = ThisWorkbook.Sheets(1)
  ws.Columns("B").ClearContents
  iLastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
  iOutRow = 0
  For iRow = 1 To iLastRow Step LinesPerCell
    Set rRange = ws.Range("A" & CStr(iRow) & ":A" & CStr(iRow + LinesPerCell - 1))
    vCell = WorksheetFunction.Transpose(rRange)
    iOutRow = iOutRow + 1
    ws.Cells(iOutRow, "B") = Join(vCell, ",")
  Next iRow
  sCell = ws.Cells(iOutRow, "B")
  Do Until Right(sCell, 1) <> ","
    sCell = Left(sCell, Len(sCell) - 1)
  Loop
  ws.Cells(iOutRow, "B") = sCell
  
  MsgBox "Finished: " & Format(iLastRow, "#,###") & " numbers copied to " _
       & Format(iOutRow, "#,###") & " rows" & Space(10), vbOKOnly + vbInformation
  
End Sub
[/FONT]

Do you know what to do with this code?