CODEWITHSUNDEEP
performanceexcelvbacopy-paste
Petrik
Petrik

Reputation: 827

How can I make my code running faster? Copy cells from one sheet to another

I've created this code which is copying all values from 'Sheet1' - starting in A2 cell to the first empty row of column 1 in Sheet2.

In case that more cells are needed to be copied, it is running quite long. Is there a possibility to make it run faster?

Thanks

Sub CopyCells()

Dim CopyRow As Long

CopyRow = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row 'find last first             empty cell in destination sheet
'Sheets("Sheet1").Range("A2").Copy Destination:=Sheets("Sheet2").Range("A" & CopyRow + 1)

Call turn_on_off(False)

For I = 2 To Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

Sheets("Sheet1").Range("A" & I).Copy Destination:=Sheets("Sheet2").Range("A" & CopyRow + I - 1)

Next I
Call turn_on_off(True)
End Sub

Public Sub turn_on_off(mode As Boolean)

With Application
    .Calculation = IIf(mode = True, xlCalculationAutomatic, xlCalculationManual)
    .ScreenUpdating = mode
End With

End Sub

Upvotes: 1

Views: 799

Answers (1)

Dmitry Pavliv
Dmitry Pavliv

Reputation: 35853

There is no need to use loop:

Sub CopyCells()
    Dim CopyRow As Long
    Dim lastrow As Long
    Dim sh1 As Worksheet, sh2 As Worksheet

    Call turn_on_off(False)

    Set sh1 = ThisWorkbook.Worksheets("Sheet1")
    Set sh2 = ThisWorkbook.Worksheets("Sheet2")

    lastrow = sh1.Cells(Rows.Count, 1).End(xlUp).Row
    CopyRow = sh2.Cells(Rows.Count, 1).End(xlUp).Row

    sh2.Range("A" & CopyRow + 1).Resize(lastrow - 1).Value = _
        sh1.Range("A2:A" & lastrow).Value

    Call turn_on_off(True)
End Sub

Range.Value=Range.Value is much faster then Copy/Paste, however it copies only values (without formatting). If you need to copy formatting as well, change Range.Value=Range.Value part to:

sh1.Range("A2:A" & lastrow).Copy Destination:=sh2.Range("A" & CopyRow + 1)

Upvotes: 1

Related Questions