Copy and paste if the cell value starts with certain letter

In Column A, there is data which contain question, choices and other data. The choices starts with A B C D in each row. I just need to copy the CHOICES and QUESTION and paste into next Column B. Sample data as shown below.

I tried the below code, but it copies only the choices no the question whihc is above choice A. I need help to fix the code. Also this code runs slowly.

ColA	ColB
Program Math
Exercise 3-24
This is a sample test
Select the correct answer
1 Question	1 Question
A choice-1	A choice-1
B choice-2	B choice-2
C choice-3	C choice-3
D choice-4	D choice-4
Program Math
Exercise 5-12
This is a sample test
Select the correct answer
2 Question	2 Question
A choice-1	A choice-1
B choice-2	B choice-2
C choice-3	C choice-3
D choice-4	D choice-4
Program Math
Exercise 2-14
This is a sample test
Select the correct answer
1 Question
A choice-1
B choice-2
C choice-3
D choice-4

Sub CopyPasteChoices()

Dim a As Range
Dim b As Range
Dim c As Range
Dim d As Range

Sheet2.Activate

For Each a In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    If a.Value Like "A *" Then
        a.Copy Destination:=a.Offset(0, 2)
    End If
Next a

For Each b In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    If b.Value Like "B *" Then
        b.Copy Destination:=b.Offset(0, 2)
    End If
Next b

For Each c In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    If c.Value Like "C *" Then
        c.Copy Destination:=c.Offset(0, 2)
    End If
Next c

For Each d In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    If d.Value Like "D *" Then
        d.Copy Destination:=d.Offset(0, 2)
    End If
Next d

End Sub

Solution

You can combine the criterias into one loop with including the check for the Question. This will also speed up the execution.

Sub CopyPasteChoices()

Dim a As Range

Sheet2.Activate

For Each a In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    If a.Value Like "A *" Then a.Offset(-1).Copy Destination:=a.Offset(-1, 2)
    If a.Value Like "A *" Or a.Value Like "B *" Or a.Value Like "C *" Or a.Value Like "D *" Then
        a.Copy Destination:=a.Offset(0, 2)
    End If
Next a


End Sub