find words in a row and format

[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