Remove duplicates in all sheets simultaneously through VBA

[cgc0512]

I have this code that I used back then for the removal of duplicates in all sheets. When I used it on my current workbook, it suddenly returned with a run-time error '1004' pointing to the range that I defined. What I want to do is to remove all duplicates based off their value in column F. Can somebody please help me revise the code? Also, would it be possible to revise it so that will ignore specific named sheets? Thanks!

Sub RemoveDuplicates()
 ' RemoveDuplicates Macro
 ' Selects all values then removes duplicates
 '

     ' Declare Current as a worksheet object variable.
         Dim Current As Worksheet
         Dim starting_ws As Worksheet
         Set starting_ws = ActiveSheet 'remember which worksheet is active in the beginning

         ' Loop through all of the worksheets in the active workbook.
         For Each Current In Worksheets
            Current.Activate
            
            ActiveSheet.Range("$A$1:$Q$1000").RemoveDuplicates Columns:=6, Header:=xlYes

         Next
         
    starting_ws.Activate 'activate the worksheet that was originally active
    
End Sub

 

[Jimmypop]

Hi There

Something like below? Not yet fully tested but this does remove duplicates as specified in Column F and it also excludes Sheet2 and Sheet4...

Sub RemoveDuplicates()
 ' RemoveDuplicates Macro
 ' Selects all values then removes duplicates
     ' Declare Current as a worksheet object variable.
         Dim Current As Worksheet
         Dim starting_ws As Worksheet
         Set starting_ws = ActiveSheet 'remember which worksheet is active in the beginning
         ' Loop through all of the worksheets in the active workbook.
         For Each Current In Worksheets
             Select Case Current.Name
               Case "Sheet2", "Sheet4"
               'Excluded
               Case Else
            Current.Activate
            ActiveSheet.Range("$A$1:$Q$1000").RemoveDuplicates Columns:=6, Header:=xlYes
    End Select
         Next
    starting_ws.Activate 'activate the worksheet that was originally active
End Sub