macro seleziona range molto lenta

Dim Controllo As Boolean

Sub DoppiaMacro_1()
'doppia macro 1/2 click foglio mailstampa

Dim avviso As String

   If Controllo = True Then

      'Call seleziona_per_mail
      Call togli_seleziona_per_mail_1
              
      Controllo = False

   Else

      'Call togli_seleziona_per_mail
      Call seleziona_per_mail_1
              
      Controllo = True

   End If

 End Sub




Sub seleziona_per_mail_1() '<<< ok
'foglio mail


Application.ScreenUpdating = False


Dim Selezione As Range, R As Range, R2 As Range, rng As Range
Dim avviso As String
Dim I As Long

 ActiveSheet.Unprotect "987654"

 'If Range("X1") = "" Then
 
 
 If Range("A5") = "" Then
avviso = MsgBox("non c'è niente da selezionare!", vbExclamation + vbOKOnly + vbDefaultButton2, "AVVISO")
 If avviso = vbOK Then
Exit Sub
 End If
 End If
  
    Set rng = Range("A3:Q84")
    For I = rng.Rows.Count To 1 Step -1
        If WorksheetFunction.CountA(rng.Rows(I)) = 0 Then
            rng.Rows(I).EntireRow.Hidden = True
        End If
    Next I
    
      
    With Sheets("foglio1").Range("A3:Q84") '<== sostituisci il nome del foglio, oppure usa ActiveSheet
        For Each R In .Rows
            For Each R2 In R.Cells
                If R2 <> "" Then
                    If Selezione Is Nothing Then
                        Set Selezione = R
                    Else
                        Set Selezione = Uni0n(R, Selezione)
                    End If
                    Exit For
                End If
            Next R2
        Next R
    End With
    If Not Selezione Is Nothing Then Selezione.Select
    Set Selezione = Nothing
    
    'Range("X1") = 1
       
'ActiveSheet.Protect "987654"
ActiveSheet.Protect Password:="987654", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingCells:=False, AllowInsertingHyperlinks:=False, AllowFiltering:=True
        
    Selection.Copy
         

Application.ScreenUpdating = False

 
End Sub


           
           

           

Sub togli_seleziona_per_mail_1() '<<< ok
'foglio mail

Dim Selezione As Range, R As Range, R2 As Range, rng As Range

Dim I As Long

ActiveSheet.Unprotect "987654"
Application.ScreenUpdating = False

      Set rng = Range("A3:Q84")
    For I = rng.Rows.Count To 1 Step -1
        If WorksheetFunction.CountA(rng.Rows(I)) = 0 Then
            rng.Rows(I).EntireRow.Hidden = False
        End If
    Next I
     
  'Range("X1") = ""
  
ActiveSheet.Protect "987654"
 Application.CutCopyMode = False

'End If

Application.ScreenUpdating = True

Range("A5").Select

End Sub

   Application.ScreenUpdating = False
 
  'Application.DisplayStatusBar = False
   Application.Calculation = xlCalculationManual
   'Application.EnableEvents = False
   ActiveSheet.DisplayPageBreaks = False

  'Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic
'Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True


 Selection.Copy
 

Application.ScreenUpdating = True