エクセルVBA　マクロの作成をお願い致します。

シートをどのように指定するかの説明がないので、取りあえず対象シートでセルを選択することで代用しています（A1セルに特に意味はありません）。

Sub Sample()
    Dim 選択セル As Range
    
    On Error Resume Next
    
    Set 選択セル = Application.InputBox("転記元シートの A1セルを選択してください。", "シート選択", Type:=8)
    If 選択セル Is Nothing Then Exit Sub
    
    Dim srcWS As Worksheet
    Set srcWS = 選択セル.Parent
    
    Set 選択セル = Application.InputBox("転記先シートの A1セルを選択してください。", "シート選択", Type:=8)
    If 選択セル Is Nothing Then Exit Sub
    
    Dim dstWS As Worksheet
    Set dstWS = 選択セル.Parent
    
    On Error GoTo 0
    Dim c As Long
    For c = 1 To srcWS.Cells(1, Columns.Count).End(xlToLeft).Column Step 2
        If IsDate(srcWS.Cells(1, c).Value) = True Then
            Set 選択セル = dstWS.Rows(1).Find(what:=DateValue(srcWS.Cells(1, c).Value), LookIn:=xlFormulas)
            If Not 選択セル Is Nothing Then
                srcWS.Cells(3, c).Resize(srcWS.UsedRange.Rows.Count, 2).Copy _
                    dstWS.Cells(3, 選択セル.Column).Resize(srcWS.UsedRange.Rows.Count, 2)
            End If
        End If
    Next
End Sub