Transferring data workbook to workbook

[Chunk]

Good afternoon,


I have two workbooks I am trying to transfer data between


workbook1 is the source file


workbook2 is the destination file


The source file that I receive usually comes to me with more columns of data than I need, and columns are never in the same order.


All of the columns in the source and destination files have a title


What I would like to be able to do is search for the desired header, copy the data for the latest date (11/25/22), then paste it into workbook2 in the appropriate spot


Attached are examples of workbook1 and workbook2. Sample numbers are inserted to show where data starts and where I would like it to go.

Please let me know if I need to better explain anything.

Any help you can give is greatly appreciated.

Chunk

[Chunk]

The "latest" date is always going to be a Friday date

[Grade4.2]

Sub copyData()

Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim r1 As Range, r2 As Range
Dim lRow As Long
Dim title As String


Set wb1 = Workbooks("workbook1.xlsx") 'source workbook
Set ws1 = wb1.Sheets("Sheet1")


Set wb2 = Workbooks("workbook2.xlsx") 'destination workbook
Set ws2 = wb2.Sheets("Sheet1")


row = 2
Do While ws1.Range("A" & row).Value <> ""
col = 2
Do While ws1.Range(Cells(1, col).Address).Value <> ""
Set rng1 = ws1.Range("A" & row)
Set rng2 = ws1.Range(Cells(1, col).Address)
Set rng3 = ws2.Range("A:A").Find(rng2.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not rng3 Is Nothing Then
Set rng4 = ws2.Range("1:1").Find(rng1.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not rng4 Is Nothing Then
ws2.Cells(rng3.row, rng4.Column).Value = ws1.Cells(rng1.row, rng2.Column).Value
End If
End If
col = col + 1
Loop
row = row + 1
Loop


End Sub