Copy a column value when the values match to multiple sheets of the workbook

[sofas]

Hello, I was trying to copy the data of column H to another sheet with two conditions. First, search for the matching value in column A, search for the date in cell H2 in row 3 of sheet 2, and put the value in the target cell. This code is random, but it does that. I want to modify the code to copy the values. For several sheets in the workbook, the names of the worksheets to be searched are placed in column G, and each value is copied to the target sheet when it matches the previous conditions. Remember them so that the value is not copied to the sheet it corresponds to in Colum G.

Sub Find_And_copy()

Dim sh1 As Worksheet, sh2 As Worksheet
Dim c As Range, f As Range

    Set sh1 = Sheet1
    Set sh2 = Sheet2
    
 
Dim r As Range, Rng As Range
    Application.ScreenUpdating = False
    
    With sh2
        For Each r In .Range("A4", .Cells(Rows.Count, 1).End(xlUp))
            Set Rng = sh1.Range("A:A").Find(r.Value, , xlValues, xlWhole)
            If Not Rng Is Nothing Then
            
    For Each c In Application.Intersect(sh1.UsedRange, sh1.Range("h2"))
       If Len(c.Value) > 0 And Application.CountA(c.EntireColumn) > 1 Then
Set f = sh2.Rows(3).Find(What:=c.Value, LookIn:=xlValues, _
                                         LookAt:=xlWhole)
            If Not f Is Nothing Then
        sh2.Cells(r.Row, f.Column).Value = Rng.Offset(, 7).Value
                          
      End If
     End If
    Next c
   End If
 Next
End With
    Application.ScreenUpdating = True
End Sub

Book1

MediaFire is a simple to use free service that lets you put all your photos, documents, music, and video in a single place so you can access them anywhere and share them everywhere.

www.mediafire.com

 

[sofas]

Welcome. Waiting for any suggestion or idea. Thanks in advance