Match a Date between 2 Worksheets then Copy and Paste Specific Data

Question

• I have 2 work sheets.
• In Sh1 I enter a date in Cell 'R2'.
• The macro should then search Sh2 column 'C' for a match.
• When a match is found it will copy from 2 cells below my match & 74 cells down then PasteSpecial xlPasteValues in Sh1 Cell 'R3'.

The Below example does something similar but not the desired result.

Option Explicit 
Sub FindStr() 

Dim rFndCell As Range 
Dim strData As String 
Dim stFnd As String 
Dim fCol As Integer 
Dim sh As Worksheet 
Dim ws As Worksheet 

Set ws = Sheets("CTN ORIGINAL") 
Set sh = Sheets("Ctn Daily - (enter data here)") 
stFnd = ws.Range("R2").Value 

With sh 
    Set rFndCell = .Range("C:C").Find(stFnd, LookIn:=xlValues) 
    If Not rFndCell Is Nothing Then 
        fCol = rFndCell.Column 
        ws.Range("B3:B33").Copy
        sh.Cells(6, fCol).PasteSpecial xlPasteValues
    Else 'Can't find the item
        MsgBox "No Find" 
    End If 
End With 

End Sub

Answer 1

Here, I got one for you, if it is not working let me know. I already tested it and it perfectly work for me.

Option Explicit

Sub findAndCopy()

    Dim foundCell As Range
    Dim strFind As String
    Dim fRow, fCol As Integer
    Dim sh1, sh2 As Worksheet

    'Set sheets
    Set sh1 = Sheets("Sheet1")
    Set sh2 = Sheets("Sheet2")

    'Get find string
    strFind = sh1.Range("R2").Value

    'Find string in column C of Sheet2
    Set foundCell = sh2.Range("C:G").Find(strFind, LookIn:=xlValues)

    'If match cell is found
    If Not foundCell Is Nothing Then

        'Get the row and column
        fRow = foundCell.Row
        fCol = foundCell.Column

        'copy data from Sheet2 (from 2 cell below & 74 cells down)
        sh2.Range(Cells(fRow + 2, fCol).Address & ":" & Cells(fRow + 76, fCol).Address).Copy

        'paste in range R3 of Sheet1
        sh1.Range("R3").PasteSpecial xlPasteValues

        'Clear cache
        Application.CutCopyMode = False

    'If not found, show message.
    Else

        Call MsgBox("Not found the match cell!", vbExclamation, "Finding String")

    End If

End Sub