Macro to move data horizontal in one line

[JohnGreen2]

I have data in column B that run down I want to the data to look like column C. You will notice column B the value run down....I need it to look like the data in Column C

Rep given for someone that can assist with a macro to do the whole column B's data to column C.also in Column C if the spaces can be deleted as it should look like


145
125
149 ......no spaces in column C

Thanks for any help

[Mumps1]

Try:

Sub JohnGreen()
    Application.ScreenUpdating = False
    Dim LastRow As Long, x As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For x = 1 To LastRow Step 4
        Cells(x, 3) = Join(Application.Transpose(Range(Cells(x, 2), Cells(x + 2, 2)).Value), "")
    Next x
    Columns(3).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Application.ScreenUpdating = True
End Sub

[JohnGreen2]

Try:

Sub JohnGreen()
    Application.ScreenUpdating = False
    Dim LastRow As Long, x As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For x = 1 To LastRow Step 4
        Cells(x, 3) = Join(Application.Transpose(Range(Cells(x, 2), Cells(x + 2, 2)).Value), "")
    Next x
    Columns(3).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Application.ScreenUpdating = True
End Sub

Hi thanks very much for your help but this splited one number off ??

[Fluff13]

Another option

Sub JohnGreen2()
   Dim Rng As Range
   
   For Each Rng In Range("B:B").SpecialCells(xlConstants).Areas
      Rng.Offset(, 1).Resize(1, 1).Value = join(Application.Transpose(Rng), "")
   Next Rng
End Sub

[JohnGreen2]

Another option

Sub JohnGreen2()
   Dim Rng As Range
   
   For Each Rng In Range("B:B").SpecialCells(xlConstants).Areas
      Rng.Offset(, 1).Resize(1, 1).Value = join(Application.Transpose(Rng), "")
   Next Rng
End Sub

Fluff13 thank you very much this works great but your macro dont delete spaces in column C....but it works great.....just need spaces removed in Column C then its perfect. Thanks very much

[Mumps1]

The macro assumes that there is only one blank row between groups of numbers. Fluff's macro will take care of that. Just add

Columns(3).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

to his code to delete the spaces.

[JohnGreen2]

The macro assumes that there is only one blank row between groups of numbers. Fluff's macro will take care of that. Just add

Columns(3).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

to his code to delete the spaces.

Thank you very much rep for both off you for your help

[Mumps1]

Glad we could help.

[Fluff13]

You're welcome & thanks for the feedback

[jolivanes]

No need to worry about empty cells in the results column.

Sub Maybe()
Dim myAreas As Areas, i As Long
Set myAreas = Sheets("Sheet1").Columns(2).SpecialCells(2).Areas
    For i = 1 To myAreas.Count
        Cells(i, 3).Value = Join(Application.Transpose(myAreas(i)), "")
    Next i
End Sub