如何复制范围相邻的数据

Question

I have written some code that copy and pastes data onto another sheet using two strings as the range. These strings are in "B" and I need the data between them in columns "C" and "D" to be pasted into B2 and C2 on "PriorityProgress" I am not intrested in the data in column "B" Other then the String I use for the Start of the range.

The code I've written works on a button click and finds the two strings that set the range in column "B" and pastes all the data between the strings in "B" fine but not sure how to go about getting the data in columns "C" and "D" to paste into columns "B" and "C".

Dim r As Range, fr As String    'First Range implementation stage
Dim c As Range, fc As String    'End Range ER's at 25
Dim StartR As Integer
Dim EndR As Integer

fr = "Originating Project ERs at Implementation Stage"
fc = "Originating Project ERs at 25"
Set r = Worksheets("Sheet1").Cells.Find(What:=fr, LookAt:=xlWhole)
Set c = Worksheets("Sheet1").Cells.Find(What:=fc, LookAt:=xlWhole)
If Not r Is Nothing Then
    StartR = r.Row + 1
Else
    MsgBox fr & " not found"
End If
If Not c Is Nothing Then
    EndR = c.Row - 1
Else
    MsgBox fc & " not found"
End If
If r.Row And c.Row > 1 Then
    Worksheets("Sheet1").Range(r, c).Copy
    Worksheets("PriorityProgress").Range("B2").PasteSpecial Paste:=xlPasteFormulas
End If

Here Is some sample data of what I am hoping to acheive:

Updated Sample data

Answer 1

Oh, this is easy. You need to edit your code at the end.

If r.Row And c.Row > 1 Then
    Worksheets("Sheet1").Range(r, c).Copy
    Worksheets("PriorityProgress").Range("C2").PasteSpecial Paste:=xlPasteFormulas
    Worksheets("PriorityProgress").Range("D2").PasteSpecial Paste:=xlPasteFormulas
End If

Please note that this code pastes formula's in Column C & D. If you need to paste the values with the formula's, you need to use below code instead.

If r.Row And c.Row > 1 Then
    Worksheets("Sheet1").Range(r, c).Copy
    Worksheets("PriorityProgress").Range("C2").PasteSpecial Paste:=xlPasteValues
    Worksheets("PriorityProgress").Range("D2").PasteSpecial Paste:=xlPasteValues
End If