Hi Mag,

Hope this will help you.

Code:
Sub GetSummary()
    
    Dim wks As Worksheet
    
    For Each wks In ThisWorkbook.Worksheets
        If wks.Name <> "Summary" Then
            With wks
                Intersect(.Range("B5").CurrentRegion, .Range("B5").CurrentRegion.Offset(1)).Copy
            End With
            With ThisWorkbook.Worksheets("Summary")
                .Range("A" & .Range("D" & Rows.Count).End(xlUp).Row + 1).PasteSpecial
                Application.CutCopyMode = False
           End With
        End If
    Next
    With ThisWorkbook.Worksheets("Summary")
        .Range("A1").Value = "Item"
        .Range("B1").Value = "Qty"
        .Range("C1").Value = "Rate"
        .Range("D1").Value = "Total"
    End With
End Sub
Regards
Prince