在VBA中，如何创建一个代码来匹配2张纸上的日期并将数据粘贴到该匹配的日期作为值？ 不能为此使用vlookup

Question

So I have 2 sheets on Excel, Calculator and Results Sheets.

On the calculator sheet, Cell A1 has the current date. On the results sheet, Cells A2:Infinity have dates increasing by day.

I am trying to write a program where IF Cells A1 from Calculator sheet are equal to cells A2:Infinity from the Results Sheet, it will copy paste the data cells range C2:C7 from the calculator sheet to the matched date on the results sheet as Transposed Values to the cell range (B:G)

VLOOKUP wont work as the previous data would be gone because of a change of dates.

Results Sheet

Calculator Sheet

Any help would be appreciated!

Answer 1

you can try this code:

Option Explicit

Sub main()
    Dim f As Range, calculatorData As Range
    Dim dateStrng As String

    With Worksheets("Calculator") '<--| reference "Calculator" worksheet
        Set calculatorData = .Range("C2:C7") '<--| set its range with data to be copied
        dateStrng = .Range("A1").value '<-- retrieve the date to be searched
    End With

    With Worksheets("Results") '<--| reference "Results" worksheet
        Set f = .Range("A2", .Range("A2").End(xlDown)).Find(what:=dateStrng, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False) '<-- look for searched data in its column "A" cells from row 2 down to last contiguous non empty cell
    End With

    If Not f Is Nothing Then f.Offset(, 1).Resize(, 6).value = Application.Transpose(calculatorData.value) '<--| if date is found then copy relevant values from "Calculator" next to it
End Sub

---

edit:

should those dates in excel worksheets be not String values but actual Date ones, then just change:

dateStrng = .Range("A1").value '<-- retrieve the date to be searched

into:

dateStrng = WorksheetFunction.Text(.Range("A1").value, "[$-409]mmmm,dd-yyyy;@") '<-- retrieve the date to be searched in the proper language (e.g.: 409 = English)

you can find all language codes here