条件とVBAで別のシートから値をコピー

ジョナスPalačionis：

私sheet_oneのようになります。

    2019-12-31
A   2
B   3
C   10

私sheet_twoのようになります。

   2019-12-31  2020-01-31  2020-02-29  2020-03-31  2020-04-30  2020-05-31  2020-06-30  2020-07-31  2020-08-31  2020-09-30  2020-10-31  2020-11-30  2020-12-31
A                                                   
B                                                   
C                                                   

私の目標は、から値をコピーすることですsheet_oneへのsheet_two日付が一致するようにされている場合sheet_two、次のようになります。

   2019-12-31  2020-01-31  2020-02-29  2020-03-31  2020-04-30  2020-05-31  2020-06-30  2020-07-31  2020-08-31  2020-09-30  2020-10-31  2020-11-30  2020-12-31
A  2                                                   
B  3                                                 
C  10                                                 

私は私の日を変更した後sheet_oneの言うようにする2020-02-29と、同じ値でスクリプトを実行しますsheet_oneが、変更された日付でsheet_two次のようになります。

   2019-12-31  2020-01-31  2020-02-29  2020-03-31  2020-04-30  2020-05-31  2020-06-30  2020-07-31  2020-08-31  2020-09-30  2020-10-31  2020-11-30  2020-12-31
A  2                       2                            
B  3                       3                          
C  10                      10                           

私は試してみました：

Sub test()

    Dim rngDate As Range, rngLetter As Range
    Dim dDate As Date
    Dim LastRow As Long, LastColumn As Long, i As Long, y As Long
    Dim Letter As String, strValue As String

    With ThisWorkbook.Worksheets("Sheet1")

        'Let as assume that Column A includes the letters. Find LastRow
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        'Let as assume that Row 1 includes the Dates. Find LastColumn
        LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
        'Test if there available Dates
        If LastColumn > 1 Then
            'Test if there available Letters
            If LastRow > 1 Then
                'Loop Dates
                For i = 2 To LastColumn
                    'Set dDate
                    dDate = .Cells(1, i).Value
                    'Loop Letters
                    For y = 2 To LastRow
                        'Set Letter
                        Letter = .Cells(y, 1).Value
                        'Set Value to import
                        strValue = .Cells(y, i).Value
                        'Search in Sheet2
                        With ThisWorkbook.Worksheets("Sheet2")
                            'Let as assume that Row 1 includes the Dates
                            'Search for the dDate in Row 1
                            Set rngDate = .Rows(1).Find(What:=dDate, LookIn:=xlValues, lookat:=xlPart)
                            'Check if date found
                            If Not rngDate Is Nothing Then
                                'Search for the Letter in Column A
                                Set rngLetter = .Columns(1).Find(What:=Letter, LookIn:=xlValues, lookat:=xlPart)

                                If Not rngDate Is Nothing Then
                                    'Import Value
                                    .Cells(rngLetter.Row, rngDate.Column).Value = strValue
                                Else
                                    MsgBox "Letter not found"
                                End If

                            Else
                                MsgBox "Date not found"
                            End If

                        End With

                    Next y

                Next i

            End If

        End If

    End With

しかし、私は取得しています：

MsgBoxに「日付が見つかりません」

どこを私のミスであるかが、この問題に対するより良い解決策でしょうか？

ご提案をいただき、ありがとうございます。

交通渋滞：

たとえば、次のように@Naresh Bhopleの画像のように、シート1でデータ

シート2に：あなたのヘッダ範囲= B1：H1は、このコードを使用することができ

Sub Test()
Dim Rng_Header As Range: Set Rng_Header = Sheets("sheet2").[B1:H1]
Dim Ws1 As Worksheet: Set Ws1 = Sheets("Sheet1")
Dim index_column As Variant
    index_column = Application.Match(Ws1.[B1], Rng_Header, 0)    'find index column in Rng_Header
    If IsError(index_column) Then MsgBox ("does not exist date"): Exit Sub
    ''find rng_data then set ít value
    Rng_Header.Offset(1, index_column - 1).Resize(3, 1).Value2 = Ws1.[B2:B4].Value2
End Sub