Keep sheets based on color and copy paste as values. Delete the remaining ones

I have the following macro that should keep the tabs that have a specific color, turn them to values and delete all the other. The color part works in another macro that I use to PDF the sheets but not here. The second For works as well. But put together, the workbook freezes and nothing happens. Can someone point me in a direction about it?

Option Explicit

Sub test()
MsgBox (Sheets("Sheet1").Tab.ColorIndex)


End Sub

Sub ExportAsPDFSTN()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
    Dim strName As String, strPathFile As String, wsNames() As String
    Dim ws As Worksheet
    Dim wsColor() As Integer, ind As Integer
    Dim Matched As Boolean
    Dim wshtName As Variant 
      ReDim wsNames(0)
         ReDim wsColor(0)
            wsNames(0) = ThisWorkbook.Sheets("Cover").Name

    strName = ThisWorkbook.Sheets("Admin").Range("A5").Value
             Application.CalculateUntilAsyncQueriesDone
        Do While Application.CalculationState <> xlDone
          DoEvents
              Loop
      For Each ws In ThisWorkbook.Sheets
    If ws.Tab.ColorIndex = wsColor(0) And ws.Visible = xlSheetVisible Then
      ReDim Preserve wsNames(UBound(wsNames) + 1)
      ReDim Preserve wsColor(UBound(wsColor) + 1)
      wsNames(UBound(wsNames)) = ws.Name
      wsColor(UBound(wsColor)) = ws.Tab.ColorIndex
    End If
      Next ws

  For Each ws In ThisWorkbook.Worksheets
        Matched = False
        For Each wshtName In wsNames
            If wshtName = ws.Name Then
                Matched = True
                With ws.UsedRange
            .Cells.Copy
            .Cells.PasteSpecial xlPasteValues
        End With
        Application.CutCopyMode = False
            End If
        Next
        If Not Matched Then
            ws.Delete
        End If
    Next ws

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
 
 ThisWorkbook.Sheets("Admin").Activate
 ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Distributed\" & strName
 
End Sub