Sub top10()

Dim r As Range, rC As Range
Dim j As Long

'Drinks top 10
Worksheets("OLD_Master").Columns("A:H").Select
Selection.sort Key1:=Range("H1"), Order1:=xlDescending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal

Worksheets("OLD_Master").Range("A:H").AutoFilter Field:=4, Criteria1:=Array(     _
    "CMI*"), Operator:= _
    xlFilterValues
Worksheets("OLD_Master").Range("A:H").AutoFilter Field:=5,   Criteria1:="Drinks"

Set r = Nothing
Set rC = Nothing
j = 0

Set r = Range("B2", Range("B" &     Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)

For Each rC In r
    j = j + 1
    If j = 10 Or j = r.Count Then Exit For
Next rC

Range(r(1), rC).SpecialCells(xlCellTypeVisible).Copy

Worksheets("For Slides").Range("P29").PasteSpecial
Worksheets("OLD_Master").ShowAllData

End Sub

Set r = Range("B2", Range("B" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)

Set r = Range("B2", Range("B" & Rows.Count).End(xlUp))
' Check if r is only 1 cell
If r.Count = 1 Then
    r.Copy
Else ' Your previous code
    Set r = r.SpecialCells(xlCellTypeVisible)
    For Each rC In r
        j = j + 1
        If j = 10 Or j = r.Count Then Exit For
    Next rC
    Range(r(1), rC).SpecialCells(xlCellTypeVisible).Copy
End If