Execute Time (Select, Copy & Paste in same order for Non Adjacent Cells)

Question

This VBA takes a lot of time to execute

Sub test()
    Dim IB As String
    Dim copyRng As Range, cel As Range, pasteRng As Range
    
    With Selection
        Set copyRng = Selection
    End With
    
    IB = Application.InputBox("Enter Exact Sheet Name to Paste")
    
    Set pasteRng = Sheets(IB).Range("A1")
    
    For Each cel In copyRng
        cel.Copy
        pasteRng.Range(cel.Address).PasteSpecial xlPasteAll
    Next
    Application.CutCopyMode = False
End Sub

Answer 1

Copy Non-Contiguous Ranges

• I've turned off screen updating and replaced looping through cells with looping through areas of the range.

• When you would only need values to be copied, another (vast) improvement in performance would be to copy by assignment . Then in the loop, you would use the following code:

   darg.Value = sarg.Value

  instead of sarg.Copy darg .

Option Explicit

Sub CopyNonContiguous()
    Const ProcTitle As String = "Copy Non-Contiguous"
    
    Dim srg As Range
    If TypeName(Selection) = "Range" Then
        Set srg = Selection
    Else
        MsgBox "Select a range. please.", vbCritical, ProcTitle
        Exit Sub
    End If
    
    Dim wsName As Variant
    wsName = Application.InputBox( _
        "Enter Sheet Name to Paste", ProcTitle, , , , , , 2)
    If wsName = False Then
        MsgBox "You canceled.", vbExclamation, ProcTitle
        Exit Sub
    End If
    
    Dim dws As Worksheet
    On Error Resume Next
    Set dws = ActiveWorkbook.Worksheets(wsName) ' consider 'ThisWorkbook'
    On Error GoTo 0
    If dws Is Nothing Then
        MsgBox "The worksheet '" & wsName & "' doesn't exist.", _
            vbCritical, ProcTitle
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
        
    Dim sarg As Range
    Dim darg As Range
        
    For Each sarg In srg.Areas
        Set darg = dws.Range(sarg.Address)
        sarg.Copy darg
    Next sarg

    Application.ScreenUpdating = True

    MsgBox "Cells copied.", vbInformation, ProcTitle

End Sub