Select and Copy Help

Hello,
Hi, I'm trying to copy values from different cells in "Jenny" over to another spreadsheet and place them in the Range("B9:F9") in "Jenny Sales". Problem is - the value cannot be carried over. Any help would be appreciated. Thanks

[code]

Dim H_mth_R As String
Dim H_found As String
Dim r1 As Range

H_mth_R = ThisWorkbook.Worksheets("Jenny").Range("C18").Value


On Error Resume Next
Err.Clear
H_found = ThisWorkbook.Worksheets("Jenny Sales").Range("C3").Value

If H_mth_R = H_found Then


Set r1 = ThisWorkbook.Worksheets("Jenny").Range("D6,C9:E9,F16").Select
Selection.Copy
Worksheets("Jenny Sales").Activate
Range("B9:F9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Else
MsgBox ("Error: Update is unsuccessful.")
End If
/code