[table="width: 500"]
[tr]
[td]Sub RepeatTextEveryThreeRows()
Dim D As Long, T As Long, Repeats As Long, Data As Variant, Txt As Variant
Repeats = [B][COLOR="#FF0000"][SIZE=4]2[/SIZE][/COLOR][/B]
Txt = Range("A1", Cells(Rows.Count, "A").End(xlUp))
Data = Application.Transpose(Range("B1", Cells(Rows.Count, "B").End(xlUp)).Value)
Do While D < UBound(Data)
D = D + 1
If (D Mod 3) = 0 Then
If IsArray(Txt) Then
T = (T + 1) Mod UBound(Txt)
Data(D) = Data(D) & "|" & Application.Rept(Txt(IIf(T = 0, UBound(Txt), T), 1) & "|", Repeats)
Else
Data(D) = Data(D) & "|" & Application.Rept(Txt & "|", Repeats)
End If
Data(D) = Left(Data(D), Len(Data(D)) - 1)
End If
Loop
Data = Split(Join(Data, "|"), "|")
Range("C1").Resize(UBound(Data) + 1) = Application.Transpose(Data)
End Sub[/td]
[/tr]
[/table]