try
Sub ertert()
Dim arr, i&
Application.ScreenUpdating = False
arr = Array("Ap", "Apple", "Ba", "Banana", "Pe", "Pear")
With Sheets("Data").Range("A1").CurrentRegion
    .Parent.AutoFilterMode = False
    For i = 0 To UBound(arr) Step 2
        .AutoFilter 2, arr(i)
'        Sheets(arr(i + 1)).UsedRange.ClearContents 'uncomment if needed
        .Copy Sheets(arr(i + 1)).Range("A1")
    Next i
    .AutoFilter
End With: Application.ScreenUpdating = True
End Sub