Application.ScreenUpdating = False ' обновление экрана = False
    Selection.Copy ' Скопировать выделенное
    ActiveWorkbook.Sheets(ActiveSheet.Index +  1 ).Activate ' активируем следующий лист
    If IsEmpty(ActiveSheet.UsedRange.Value2) Then ' выделить ячейку( пооследняя строка +  1 ,  1 )
        ActiveSheet.Cells( 1 ,  1 ).Select
    Else
        ActiveSheet.Cells(UBound(ActiveSheet.UsedRange.Value2) +  1 ,  1 ).Select
    End If
    ActiveSheet.Paste ' вставить скоппированное
    ActiveSheet.Sheets(ActiveSheet.Index - 1).Activate ' активировать исходый лист
    Application.ScreenUpdating = True ' обновление экрана = True