Sub test()

Dim WB As Workbook
Dim WS As Worksheet
Dim L_Row As Integer
Dim Country As String


Set WB = ActiveWorkbook
Set WS = WB.Sheets("Arkusz1")
L_Row = WS.Range("A1").CurrentRegion.Rows.Count


For x = 2 To L_Row
     Country = WS.Range("A" & x)
         For y = x + 1 To L_Row
             If WS.Range("A" & y) = Country And WS.Range("A" & y) <> "" Then
                WS.Range("B" & x).Value = WS.Range("B" & x).Value + WS.Range("B" & y).Value
                Rows(y).EntireRow.Clear
             End If
        Next y
Next x

Range("A2:E" & L_Row).Sort key1:=Range("A2:A" & L_Row), order1:=xlAscending, Header:=xlNo


End Sub