VBA macro to move cells to a new sheet and removing cell headers in Excel

Question

I am trying to create a VBA macro to move contents on sheet 1 to rows on sheet 2. This is very similar to a question posted on here but I am unable to get the macro to work for me as I am not understanding the variable portion of the answer. Previously Answered Question
We will be pasting a block of info into sheet one that looks like this, with all data in column A across multiple cells:

Issue Description: Testing.

Priority: Standard

Person Number: xxxxxxx

Encounter Number: xxxxxxx

Reported By: John CC X. Smith May 12 2015 11:40AM TSTEST2 (jsmith)

Template Name: fts_clinical_guide_8310

So what we would like is for the information in the Issue Description cell to move to a row on Sheet 2 with the text after the ":" only and so on for the other cells. I also need all of the cell information to stay in 1 row when it gets moved to sheet 2. I hope this makes sense and I would really appreciate any help on this. Thanks.

Edit: Here is the code I am trying to modify. It mentions the original answers "headers" that I would change later. For example it mentions MyID="" and I have no idea how to put info into the quotes to make it work.

Sub MoveOver() 

Cells(1, 1).Activate 

myId = ""
myTitle = ""
myAuthor = ""

While Not ActiveCell = ""

If UCase(Left(ActiveCell, 4)) Like "*ID*" Then myId = Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell)))

If UCase(Left(ActiveCell, 4)) = "TITL" Then myTitle = Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell)))

If UCase(Left(ActiveCell, 4)) = "AUTH" Then myAuthor = Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell)))

If ActiveCell Like "*---*" Then
    'NOW, MOVE TO SHEET2!
    toRow = Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
    Sheets(2).Cells(toRow, 1) = myId
    Sheets(2).Cells(toRow, 2) = myTitle
    Sheets(2).Cells(toRow, 3) = myAuthor
    myId = ""
    myTitle = ""
    myAuthor = ""
End If

ActiveCell.Offset(1, 0).Activate

Wend

Answer 1

This will work for you

Sub SpecialCopy()
    Dim trg As Worksheet
    Set trg = ThisWorkbook.Worksheets(2)
    Dim i As Long, j As Long
    Dim lastRow As Long: lastRow = Cells(Cells.Rows.Count, 1).End(xlUp).Row
    Dim lastRow2 As Long: lastRow2 = trg.Cells(Cells.Rows.Count, 1).End(xlUp).Row + 1
    For i = 1 To lastRow ' assuming we starting from second row
        trg.Cells(lastRow2, i).Value = Split(Cells(i, 1).Value, ":")(0)
        For j = 1 To UBound(Split(Cells(i, 1).Value, ":"))
            trg.Cells(lastRow2 + 1, i).Value = trg.Cells(2, i).Value & Split(Cells(i, 1).Value, ":")(j)
        Next j
    Next i
End Sub

EDIT: I have edited the code, please let me know if this works for you.