Dim r As Long, lr As Long, rr As Long, n As Long, nr As Long, sc As Long, nc As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
nr = 0: sc = 5
For r = 1 To lr
  n = Application.CountIf(Columns(1), Cells(r, 1).Value)
  nr = nr + 1: nc = sc
  If n = 1 Then
    Cells(nr, nc).Resize(, 3).Value = Cells(r, 1).Resize(, 3).Value
  ElseIf n > 1 Then
    Cells(nr, nc).Resize(, 3).Value = Cells(r, 1).Resize(, 3).Value
    For rr = r + 1 To r + n - 1
      nc = Cells(nr, Columns.Count).End(xlToLeft).Column + 1
      Cells(nr, nc).Resize(, 2).Value = Cells(rr, 2).Resize(, 2).Value
    Next rr
  End If
  r = r + n - 1
Next r
Columns.AutoFit
Application.ScreenUpdating = True
End Sub
How do i change this code to include more columns. This code is used to reorganise similar data from columnar to rows. Much appreciated.

Kind regards,

MODERATOR NOTE:

Pls use code tags around your codes.