repetitive code, possible shortening

Hi all

I have this repetitive code, it works very well but I am wondering if it can be shortened...?
Thank you for your time and support.

Dim Sh As Worksheet
Dim cell As Range
For Each Sh In Worksheets(Array("A"))
 Sh.Range("a47:e47") = ""
 For Each cell In Sh.Range("d26:g29")
    If (Trim(cell.Text)) = Sheets("B").Range("a28").Text Then
                        Sh.Range("a47").Value = Sheets("B").Range("a28").Value
                        Sh.Range("E47").Value = Sheets("B").Range("b28").Value
                       
                    End If
              Next
       Next Sh
For Each Sh In Worksheets(Array("A"))
 Sh.Range("a48:e48") = ""
 For Each cell In Sh.Range("d26:g29")
    If (Trim(cell.Text)) = Sheets("B").Range("a29").Text Then
                        Sh.Range("a48").Value = Sheets("B").Range("a29").Value
                        Sh.Range("E48").Value = Sheets("B").Range("b29").Value
                      
                    End If
              Next
       Next Sh
For Each Sh In Worksheets(Array("A"))
 Sh.Range("a49:e49") = ""
 For Each cell In Sh.Range("d26:g29")
    If (Trim(cell.Text)) = Sheets("B").Range("a30").Text Then
                        Sh.Range("a49").Value = Sheets("B").Range("a30").Value
                        Sh.Range("E49").Value = Sheets("B").Range("b30").Value
                        
                    End If
              Next
       Next Sh
For Each Sh In Worksheets(Array("A"))
 Sh.Range("a50:e50") = ""
 For Each cell In Sh.Range("d26:g29")
    If (Trim(cell.Text)) = Sheets("B").Range("a31").Text Then
                        Sh.Range("a50").Value = Sheets("B").Range("a31").Value
                        Sh.Range("E50").Value = Sheets("B").Range("b31").Value
                        
                    End If
              Next
       Next Sh
For Each Sh In Worksheets(Array("A"))
 Sh.Range("a51:e51") = ""
 For Each cell In Sh.Range("d26:g29")
    If (Trim(cell.Text)) = Sheets("B").Range("a32").Text Then
                        Sh.Range("a51").Value = Sheets("B").Range("a32").Value
                        Sh.Range("E51").Value = Sheets("B").Range("b32").Value
                        
                    End If
              Next
       Next Sh