Esetleg ezt is megpróbálhatod. Úgy mértem, durván 5x gyorsabb, mint a ciklusos megoldás.

Kb. 55000 sornál 51 sec volt a futási idő. (Lehet, hogy a kézi szűrés-másolás ennél is gyorsabb :))

Sub töröl()
    Dim Rng As Range, WS As Worksheet
    Application.Calculation = xlCalculationManual
    Set WS = Sheets("Country Orders Data")
    Set Rng = WS.Range("B2", WS.Range("B" & Rows.Count).End(xlUp))
    WS.Range("B:B").Insert
    With Rng.Offset(, -1)
        .FormulaR1C1 = "=IF(RC[1]<>""Denmark"",1,"""")"
        .Copy
        .PasteSpecial xlPasteValues
        .SpecialCells(xlCellTypeConstants, xlNumbers).EntireRow.Delete
    End With
    WS.Range("B:B").Delete
    Application.Calculation = xlCalculationAutomatic
End Sub