Optimize Code for a Sort and then Remove Duplicates Macro

I use the following code to Copy, Sort and then Remove Duplicates and paste them onto another worksheet. Also, uploads to a few combo-boxes located in my userform. The code works great, except now that I have over 7,000 rows the code is a bit slow. Therefore, every time I want to refresh the form its slow to re-open.

I was hoping for some suggestions on how to run the code more efficiently and faster. Thanks

Option Explicit

Sub SortAndRemoveDupes()
Dim rListSort1 As Range, rOldList1 As Range
Dim rListSort2 As Range, rOldList2 As Range
Dim rListSort3 As Range, rOldList3 As Range
Dim rListSort4 As Range, rOldList4 As Range
Dim rListSort5 As Range, rOldList5 As Range
Dim rListSort6 As Range, rOldList6 As Range

Dim StrRowSource1 As String
Dim StrRowSource2 As String
Dim StrRowSource3 As String
Dim StrRowSource4 As String
Dim StrRowSource5 As String
Dim StrRowSource6 As String

 'Clear Hidden sheet Column A ready for list
  Sheet3.Range("A1", Sheet3.Range("A65536").End(xlUp)).Clear
  Sheet3.Range("B1", Sheet3.Range("B65536").End(xlUp)).Clear
  Sheet3.Range("C1", Sheet3.Range("C65536").End(xlUp)).Clear
  Sheet3.Range("D1", Sheet3.Range("D65536").End(xlUp)).Clear
  Sheet3.Range("E1", Sheet3.Range("E65536").End(xlUp)).Clear
  Sheet3.Range("F1", Sheet3.Range("F65536").End(xlUp)).Clear

  
 'Set range variable to list we want
Set rOldList1 = Sheet2.Range("A1", Sheet2.Range("A65536").End(xlUp))
Set rOldList2 = Sheet2.Range("D1", Sheet2.Range("D65536").End(xlUp))
Set rOldList3 = Sheet2.Range("H1", Sheet2.Range("H65536").End(xlUp))
Set rOldList4 = Sheet2.Range("Q1", Sheet2.Range("Q65536").End(xlUp))
Set rOldList5 = Sheet2.Range("R1", Sheet2.Range("R65536").End(xlUp))
Set rOldList6 = Sheet2.Range("S1", Sheet2.Range("S65536").End(xlUp))



 'Use AdvancedFilter to copy the list to Column A _
  of the hidden sheet and remove all dupes
rOldList1.AdvancedFilter Action:=xlFilterCopy, _
              CopyToRange:=Sheet3.Cells(1, 1), Unique:=True
rOldList2.AdvancedFilter Action:=xlFilterCopy, _
               CopyToRange:=Sheet3.Cells(1, 2), Unique:=True
rOldList3.AdvancedFilter Action:=xlFilterCopy, _
               CopyToRange:=Sheet3.Cells(1, 3), Unique:=True
rOldList4.AdvancedFilter Action:=xlFilterCopy, _
               CopyToRange:=Sheet3.Cells(1, 4), Unique:=True
rOldList5.AdvancedFilter Action:=xlFilterCopy, _
               CopyToRange:=Sheet3.Cells(1, 5), Unique:=True
rOldList6.AdvancedFilter Action:=xlFilterCopy, _
               CopyToRange:=Sheet3.Cells(1, 6), Unique:=True
                     
 'Set range variable to the new non dupe list
Set rListSort1 = Sheet3.Range("A1", Sheet3.Range("A65536").End(xlUp))
Set rListSort2 = Sheet3.Range("B1", Sheet3.Range("B65536").End(xlUp))
Set rListSort3 = Sheet3.Range("C1", Sheet3.Range("C65536").End(xlUp))
Set rListSort4 = Sheet3.Range("D1", Sheet3.Range("D65536").End(xlUp))
Set rListSort5 = Sheet3.Range("E1", Sheet3.Range("E65536").End(xlUp))
Set rListSort6 = Sheet3.Range("F1", Sheet3.Range("F65536").End(xlUp))

    With rListSort1
             'Sort the new non dupe list
             .Sort Key1:=.Cells(2, 1), Order1:=xlAscending, Header:=xlYes, _
                   OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    End With
    
    With rListSort2
             'Sort the new non dupe list
             .Sort Key1:=.Cells(2, 1), Order1:=xlAscending, Header:=xlYes, _
                   OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    End With
 
        With rListSort3
             'Sort the new non dupe list
             .Sort Key1:=.Cells(2, 1), Order1:=xlAscending, Header:=xlYes, _
                   OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    End With
 
        With rListSort4
             'Sort the new non dupe list
             .Sort Key1:=.Cells(2, 1), Order1:=xlAscending, Header:=xlYes, _
                   OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    End With
        With rListSort5
             'Sort the new non dupe list
             .Sort Key1:=.Cells(2, 1), Order1:=xlAscending, Header:=xlYes, _
                   OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    End With
        With rListSort6
             'Sort the new non dupe list
             .Sort Key1:=.Cells(2, 1), Order1:=xlAscending, Header:=xlYes, _
                   OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    End With
    
    
     'Parse the address of the sorted unique items
        StrRowSource1 = Sheet3.Name & "!" & Sheet3.Range _
           ("A2", Sheet3.Range("A65536").End(xlUp)).Address
        StrRowSource2 = Sheet3.Name & "!" & Sheet3.Range _
           ("B2", Sheet3.Range("B65536").End(xlUp)).Address
        StrRowSource3 = Sheet3.Name & "!" & Sheet3.Range _
           ("C2", Sheet3.Range("C65536").End(xlUp)).Address
        StrRowSource4 = Sheet3.Name & "!" & Sheet3.Range _
           ("D2", Sheet3.Range("D65536").End(xlUp)).Address
        StrRowSource5 = Sheet3.Name & "!" & Sheet3.Range _
           ("E2", Sheet3.Range("E65536").End(xlUp)).Address
        StrRowSource6 = Sheet3.Name & "!" & Sheet3.Range _
           ("F2", Sheet3.Range("F65536").End(xlUp)).Address
        
    Sheet3.Range("A1") = "New Sorted Unique List"
    Sheet3.Range("B1") = "New Sorted Unique List"
    Sheet3.Range("C1") = "New Sorted Unique List"
    Sheet3.Range("D1") = "New Sorted Unique List"
    Sheet3.Range("E1") = "New Sorted Unique List"
    Sheet3.Range("F1") = "New Sorted Unique List"

    
   With UserForm1.Acname1
      .RowSource = vbNullString
      .RowSource = StrRowSource1
    End With
   
   With UserForm1.Year1
      .RowSource = vbNullString
      .RowSource = StrRowSource2
    End With
     
  With UserForm1.Dept1
      .RowSource = vbNullString
      .RowSource = StrRowSource3
    End With
    
  With UserForm1.Req1
      .RowSource = vbNullString
      .RowSource = StrRowSource4
    End With
    
  With UserForm1.Req2
      .RowSource = vbNullString
      .RowSource = StrRowSource5
    End With
    
  With UserForm1.Req3
      .RowSource = vbNullString
      .RowSource = StrRowSource6
    End With

       
     
End Sub