如何复制范围相邻的数据

Question

我编写了一些代码，使用两个字符串作为范围将数据复制并粘贴到另一张纸上。 这些字符串在“ B”中，我需要将“ C”和“ D”列中它们之间的数据粘贴到“ PriorityProgress”上的B2和C2中。我不会对“ B”列中的数据感兴趣。我使用范围的开始。

我编写的代码在单击按钮时起作用，并找到了设置“ B”列中范围的两个字符串，并将所有数据粘贴到“ B”列中的字符串之间很好，但不确定如何获取列中的数据将“ C”和“ D”粘贴到“ B”和“ 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

这是我希望达到的一些示例数据：

更新的样本数据

Answer 1

哦，这很容易。 您需要在最后编辑您的代码。

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

请注意，此代码将公式的粘贴在C和D列中。如果您需要在公式的值中粘贴值，则需要使用以下代码。

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