Как ускорить код (VBA Excel)?

**********************************************************************************************************
Private Sub CommandButton1_Click()
Dim r As Range, i%, c% '&-Long, %-Integer
Dim MyCell As Range
Dim a As String
Dim MyRow As Integer 'присваиваем значение ряда последней выд. области
Dim MyCol As Integer  'присваиваем значение колонки последней выд. области
 
Set r = Selection: ' Переменной (r) присваиваем выделенную область
c = r.Areas.Count 'в (с) помещаем количество вделенных несмежных"фрагментов-областей"
                          '(Areas.Count)4
 
 
For i = 1 To c
 
        r.Areas(i).Copy
        a = r.Areas(r.Areas.Count).Address
        MyRow = Range(a).row
        MyCol = Range(a).Column
                
                For Each MyCell In r
                    'MyCell.Select
                    MyCell.Copy
                    'Range(a).Select 'выделяем последнюю в ввыделенных областях
                    
                        If RightOpBtn.Value = True Then
                            MyCol = MyCol + 1 'стрелка показывает вправо
                            Cells(MyRow, MyCol) = MyCell 'переносим поочередно информацию в "последнюю ячейку"
                        ElseIf LeftOpBtn.Value = True Then
                            MyCol = MyCol - 1 'стрелка показывает влево
                            Cells(MyRow, MyCol) = MyCell 'переносим поочередно информацию в "последнюю ячейку"
                        ElseIf UpOpBtn.Value = True Then
                            MyRow = MyRow - 1 'стрелка вверх - на ряд выше
                            Cells(MyRow, MyCol) = MyCell 'переносим поочередно информацию в "последнюю ячейку"
                        ElseIf DownOpBtn.Value = True Then
                            MyRow = MyRow + 1 'стрелка вниз - на ряд ниже
                            Cells(MyRow, MyCol) = MyCell 'переносим поочередно информацию в "последнюю ячейку"
                        End If
                
                Next
        
        
        r.Areas(c).PasteSpecial
        Application.CutCopyMode = False ' убираем выделения
Next
 
End Sub
**********************************************************************************************************