Macro running slowly, copy/paste values only from one workbook to another

Moderator please mark as solved

I set application.ScreenUpdating to false at the beginning of my code and it solved the problem.

Sub PoolSheetValuesOnly()
' Created by:   Jeanette White
' Last revised: 021011
' Purpose:      To create worksheets as values only

    'stop screen flickering
    Application.ScreenUpdating = False

     'if the personal workbook is open hide it
    If Windows("PERSONAL.XLSB").Visible Then
        Windows("PERSONAL.XLSB").Visible = False
    End If
                
    'Loop through all of the worksheets and select each worksheet
    Dim ws As Worksheet
    Dim ws_Count As Integer
    ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    For Each ws In Worksheets
        With ws
            If .Visible = True Then .Select Replace:=False
            'count the number of worksheets
                ws_Count = Worksheets.Count
            For i = 1 To ws_Count
                'copy the worksheet name to cell D1
                ws.Cells(1, 4).Value = ws.Name
            Next i
        End With
    Next ws
    
    'copy the data
    Cells.Select
    Selection.Copy
        
    'Open a new workbook
    Workbooks.Add
    
    'add worksheets to the new workbook based on the count of the original number of worksheets
    If ws_Count > 0 Then
        For i = -1 To ws_Count
            Sheets.Add After:=Sheets(Sheets.Count)
        Next i
    End If
    
    'make sure to be on the first worksheet
    Sheets("Sheet1").Select
    Range("A1").Select
    
    'Paste special values only
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    
    'remove any blank worksheets
    'turn the alert off
    Application.DisplayAlerts = False
    For Each ws In Worksheets
        If Worksheets.Count > 1 Then
            If IsEmpty(ws.UsedRange) Then
                ws.Delete
            End If
        End If
    Next ws
    'turn the alerts on
    Application.DisplayAlerts = True
    
    'loop through and name the new worksheets based on the name in the holding cell
    For Each ws In Worksheets
        ws.Name = ws.Cells(1, 4).Value
    Next
    
    'loop through and remove the worksheet name from the holding cell
    ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    For Each ws In Worksheets
        With ws
            If .Visible = True Then .Select Replace:=False
            Range("D1").Select
            Selection.ClearContents
        End With
    Next ws
    
    'go back to orginal spreadsheet
    ActiveWindow.ActivatePrevious
    
    'loop through and remove the worksheet name from the holding cell
    ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    For Each ws In Worksheets
        With ws
            If .Visible = True Then .Select Replace:=False
            Range("D1").Select
            Selection.ClearContents
        End With
    Next ws
    
    'go back to orginal spreadsheet
    ActiveWindow.ActivatePrevious
    Application.ScreenUpdating = True
End Sub