[VB] Copy paste with increment per row

So today I tried to get a freelance work in Upwork. I applied for a copy paste job. Sadly I did not read the documents and made a poor cover letter.

The job is supposed to turn the row like below


into


I still however attempted to do the work even if I have not yet won the account since there was a deadline. 3 hours after when I finally figured out the needed VB code the job is no longer available.

I feel sad for not getting the job. I'll just paste the code here for future reference.
This visual basic macro code should allow copy paste with increment per row.

Sub Messages()
'
' Messages Macro
'

'
    Dim rngmessage As Range
    Dim rngname As Range
    Dim rngtitle As Range
    Set rngmessage = Sheets("Sheet1").Range("A2")
    Set rngname = Sheets("Sheet1").Range("B2")
    Set rngtitle = Sheets("Sheet1").Range("C2")
    Set rngpaste = Sheets("Sheet2").Range("A2")
   
   
    For i = 0 To 550

        rngmessage.Copy rngpaste
        Set rngpaste = rngpaste.Offset(1, 0)
        rngname.Copy rngpaste
        Set rngpaste = rngpaste.Offset(1, 0)
        rngtitle.Copy rngpaste
        Set rngpaste = rngpaste.Offset(3, 0)


        Set rngmessage = rngmessage.Offset(1, 0)
        Set rngname = rngname.Offset(1, 0)
        Set rngtitle = rngtitle.Offset(1, 0)
       
    Next i
   
   
   
End Sub