Option Explicit

Sub CopyUserRange()
'' Author:  boa
'' Written: 05.12.2018

    Dim RunTimes As Date: RunTimes = Time
    Dim Start!:           Start = Timer

    Dim shOut As Worksheet: Set shOut = ThisWorkbook.Sheets("Лист2")    ' Лист с которого копируем
    Dim shIn As Worksheet:  Set shIn = ThisWorkbook.Sheets("Лист1")     ' Лист в который копируем
    
    Dim ArrColumnsOut(): ArrColumnsOut = Array(1, 2, 3, 4, 5, 6, 7)     ' колонки для копирования
    Dim ArrColumnsIn():  ArrColumnsIn = Array(1, 2, 3, 5, 6, 9, 10)     ' колонки куда вставляем
    If UBound(ArrColumnsOut) <> UBound(ArrColumnsIn) Then Exit Sub      ' массивы с номерами колонок должны быть одинакового  размера.

    Dim firstRowOut&: firstRowOut = 1                    ' первая строка листа с которого копируем
    Dim firstRowIn&:  firstRowIn = 7                    ' первая строка листа куда вставляем
    
    Dim LastRow&: LastRow = shOut.Cells.SpecialCells(xlLastCell).Row    ' последняя строка копируемого диапазона
    
    With Application: .ScreenUpdating = False: .EnableEvents = False: .DisplayAlerts = False: End With 'отключаем пересчет, обновление экрана и т.п.

    Dim i&: For i = LBound(ArrColumnsOut) To UBound(ArrColumnsOut)
        With shOut
            .Range(.Cells(firstRowOut, ArrColumnsOut(i)), .Cells(LastRow, ArrColumnsOut(i))).Copy shIn.Cells(firstRowIn, ArrColumnsIn(i))
        End With
    Next i

    With Application: .ScreenUpdating = True: .EnableEvents = True: .DisplayAlerts = True: End With
    
    Debug.Print "Затрачено: " & Format(Timer - Start, "#0.0") & " сек."
    MsgBox "Затрачено: " & Format(Time - RunTimes, "hh:mm:ss")
End Sub