Sub Button1_Click()
Dim s As Object
Dim dl As Long
Dim i As Long
Dim j As Byte
Dim tx As String
Set s = Sheets("Sheet1")
dl = s.Cells(Application.Rows.Count, 1).End(xlUp).Row
For i = 2 To dl
tx = ""
For j = 0 To 2
tx = IIf(tx = "", s.Cells(i, 1).Offset(j, 0).Value, tx & s.Cells(i, 1).Offset(j, 0).Value)
Next j
s.Cells(i, 2).Value = tx
s.Cells(i + 1, 2).Value = tx
s.Cells(i + 2, 2).Value = tx
i = i + 2
Next i
End Sub