find words in a row and format

[Excel Fox]

Can you post a sample file?

[codedreamer]

This is an example of how it looks and how I would like it to be formatted.
Thank you,
codedreaner

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.eileenslounge.com/viewtopic.php?f=44&t=40455&p=313035#p313035
https://www.eileenslounge.com/viewtopic.php?f=18&t=40411&p=312889#p312889
https://www.eileenslounge.com/viewtopic.php?f=18&t=40411&p=312886#p312886
https://www.eileenslounge.com/viewtopic.php?f=18&t=40411&p=312752#p312752
https://www.eileenslounge.com/viewtopic.php?f=18&t=40411&p=312734#p312734
https://www.eileenslounge.com/viewtopic.php?f=18&t=40411&p=312727#p312727
https://www.eileenslounge.com/viewtopic.php?f=18&t=40411&p=312724#p312724
https://www.eileenslounge.com/viewtopic.php?f=44&t=40374&p=312535#p312535
https://www.eileenslounge.com/viewtopic.php?p=312533#p312533
https://www.eileenslounge.com/viewtopic.php?f=44&t=40373&p=312499#p312499
https://www.youtube.com/watch?v=jTmVtPHtiTg&lc=Ugy_RiNN_kAqUvZ8W994AaABAg. 9xhyRrsUUOM9xpn-GDkL3o
https://www.youtube.com/watch?v=jTmVtPHtiTg&lc=Ugy_RiNN_kAqUvZ8W994AaABAg
https://www.youtube.com/watch?v=jTmVtPHtiTg&lc=UgzlC5LBazG6SMDP4nl4AaABAg
https://www.youtube.com/watch?v=jTmVtPHtiTg&lc=UgzlC5LBazG6SMDP4nl4AaABAg. 9zYoeePv8sZ9zYqog9KZ5B
https://www.youtube.com/watch?v=jTmVtPHtiTg&lc=Ugy_RiNN_kAqUvZ8W994AaABAg. 9xhyRrsUUOM9zYlZPKdOpm
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA

[Rick Rothstein]

Give this macro a try...

Sub RearrangeFruits()
  Dim X As Long, LastColumn As Long, Arr As Variant
  Const StartCell As String = "K1"
  Const StartOutputCell As String = "A4"
  LastColumn = Cells(Range(StartCell).Row, Columns.Count).End(xlToLeft).Column
  Arr = Range(StartCell, Cells(Range(StartCell).Row, LastColumn))
  Range(StartOutputCell).Resize(, 2).Value = Array("Fruit", "Quantity")
  For X = 1 To UBound(Arr, 2) Step 5
    With Range(StartOutputCell)
      .Offset(Int(1 + (X - 1) / 5), 0) = Arr(1, X + 1)
      .Offset(Int(1 + (X - 1) / 5), 1) = Arr(1, X + 3)
      .Offset(Int(1 + (X - 1) / 5), 2) = Arr(1, X + 4)
    End With
  Next
End Sub

NOTE: You will need to adjust the two constants (the Const statements) to reflect your actual start of data (I used K1 and A4 because that is where you showed them to be in your sample file).

[codedreamer]

Thank you so much. It did work!
I would like to know if you can explain this line to me?
LastColumn = Cells(Range(StartCell).Row, Columns.Count).End(xlToLeft).Column
Thanks again,

codedreaner

[codedreamer]

I went through it several times, I understand now.
Thanks again,

codedreamer