0

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
braX
  • 11,506
  • 5
  • 20
  • 33
Shawon
  • 11
  • Replace the contents of your loop with `cel.Copy pasteRng.Range(cel.Address)`. – GSerg Nov 20 '21 at 08:26
  • Dear @GSerg, still it is taking a lot of time. My sheet has abount 3000 cells to copy & paste in another sheet. -Thank You – Shawon Nov 20 '21 at 08:39
  • If you want to copy the formatting, as you appear to, then you don't have too many options for non-continuous ranges. It would be faster if you only wanted the values. – GSerg Nov 20 '21 at 09:00
  • Could you share some of those range addresses and a screenshot or two of your data? Since `pasteRange` is `A1`, isn't `pastRng.Range(cel.Address)` the same as `Sheets(IB).Range(cel.Address)`? Looping through the areas (instead of cells) of `copyRng` may considerably reduce the time of execution. – VBasic2008 Nov 20 '21 at 09:20
  • @VBasic2008 You can [step out of a defined range](https://stackoverflow.com/a/41450309/11683), which in case of "A1" will simply be "that range on that sheet" (it has more interesting behaviours in less trivial cases). Looping through areas is a great suggestion though, unless each area is a single cell. – GSerg Nov 20 '21 at 09:35
  • @GSerg: Thanks for the link to an interesting read. I accidentally witnessed that behavior a few times but never gave much thought to it. Now I did. – VBasic2008 Nov 20 '21 at 10:22

1 Answers1

0

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
VBasic2008
  • 44,888
  • 5
  • 17
  • 28