how using offset to clear data in range and avoid repeating to copy

[abdo meghari]

hi experts
I got this code for @DanteAmor

Sub through_all_sheets()
  Dim sh1 As Worksheet, sh As Worksheet
  Dim f As Range
  Dim j As Long, lr1 As Long, lr As Long
  Set sh = Sheet1
  Set sh1 = sheet3

      lr1 = sh1.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row + 1
      lr = sh.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row
      For j = 2 To sh.Cells(1, Columns.Count).End(1).Column
        Set f = sh1.Rows(1).Find(sh.Cells(1, j), , xlValues, xlWhole, , , False)
        If Not f Is Nothing Then
        sh1.Cells(lr1, f.Column).Offset(1, 0).ClearContents
        sh1.Cells(lr1, f.Column).Resize(lr).Value = sh.Cells(2, j).Resize(lr).Value
        End If
      Next
   
 
End Sub

and I adjusted what I need it but there is poblem when brings data based on headers . it copy to the bottom repeatedly when run macro more than one time . it should replace data instead of copy to the bottom repeatedly . I try put this line into the code but doesn't succeed

sh1.Cells(lr1, f.Column).Offset(1, 0).ClearContents

 

[abdo meghari]

any idea to fix it?