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
Bookmarks