How to copy data outside of range

Question

I am trying to copy some data that is a column over from a range I have set using two strings. the range is set in column 'B' and I need to copy the data in columns 'C' and 'D' to the length of the range and paste them into another sheet in columns 'B' and 'C'.

The range is set by finding two strings "Originating Project ERs at Implementation Stage" and "Originating Project ERs at 25".

So far I have managed to write code that copies the data into the correct location but it is only copying the data in the Range (Column "B")

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).Offset(1,1).Copy
Worksheets("PriorityProgress").Range("B2").PasteSpecial Paste:=xlPasteValues
Worksheets("priorityProgress").Range("C2").PasteSpecial Paste:=xlPasteValues

End If`

Here is some sample data showing what i'd like to acheive https://i.stack.imgur.com/5csrZ.png

Edit : I've managed to use OffSet 1,1 to display the first set of records in column 'C' and now just need 'D'

Answer 1

Managed to solve it by offsetting each column individually

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

Answer 2

Does this work?

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"
        Exit Sub
End If

If Not c Is Nothing Then
    EndR = c.Row - 1
        Else: MsgBox fc & " not found"
        Exit Sub
End If

Range(r.Offset(1, 1), c.Offset(-1, 1)).Resize(, 2).Copy
Worksheets("PriorityProgress").Range("B2").PasteSpecial Paste:=xlPasteValues