Copy Pasting a lot of data using ActiveCell Offset

[dejamls]

Hi
Below is some code I have. There's actually a lot of copying and pasting going on between workbooks (more than I show below).
I would like to speed up the macro and was wondering is there better faster way to copy paste a number of cells on a worksheet that have been identified with a ActiveCell.Offset to another workbook sheet.
Cheers in advance

Sub CopyPaste()
 
Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    
    Dim wsDestA As Worksheet 'Destination workbook + sheet    
    Set wsDestA = Workbooks("SRS Bulk Sample Lodgement.xlsm").Worksheets("Atmospheric") 'Destination workbook + sheet
    
    'Sample Date
    ActiveCell.Offset(0, 1).Copy
    wsDestA.Range("B56535").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    'Sample ID
    ActiveCell.Offset(0, 2).Copy
    wsDestA.Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    'First Name
    ActiveCell.Offset(0, 3).Copy
    wsDestA.Range("L65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    'Last Name
    ActiveCell.Offset(0, 4).Copy
    wsDestA.Range("K65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    'DoB
    ActiveCell.Offset(0, 18).Copy
    wsDestA.Range("M1000000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    'Gender
    ActiveCell.Offset(0, 19).Copy
    wsDestA.Range("N65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True

End Sub

 

[sykes]

There shouldn't be any need to "Copy & Paste" - just set one range equal to the other....

Dim wsDestA As Worksheet 'Destination workbook + sheet
    Set wsDestA = Workbooks("SRS Bulk Sample Lodgement.xlsm").Worksheets("Atmospheric") 'Destination workbook + sheet
    
    'Sample Date
    
    wsDestA.Range("B56535").End(xlUp).Offset(1, 0).Value = ActiveCell.Offset(0, 1)

    'Sample ID
    
    wsDestA.Range("A65536").End(xlUp).Offset(1, 0).Value = ActiveCell.Offset(0, 2)

Etc etc...

 

[sykes]

You could also use a "With" statement to shorten the code even further:

    With wsDestA
        'Sample Date
        .Range("B56535").End(xlUp).Offset(1, 0).Value = ActiveCell.Offset(0, 1)
        'Sample ID
        .Range("A65536").End(xlUp).Offset(1, 0).Value = ActiveCell.Offset(0, 2)
    End With

 

[dejamls]

Thanks skyes. Makes sense. Appreciated.

 

[sykes]

Pleasure! Has it improved your project?

Out of interest, in your "Atmospheric" worksheet, does all the data always finish on the same row? - i.e. when the code fires, is it going along the same row, and pushing the data into the various cells of that next available row? I'm assuming that it does.
If this IS the case, then we could speed things up AND further reduce your code - quite significantly:

Dim wsDestA As Worksheet 'Destination workbook + sheet
Dim nxt_rw As Long

Set wsDestA = Workbooks("SRS Bulk Sample Lodgement.xlsm").Worksheets("Atmospheric") 'Destination workbook + sheet
    
    With wsDestA
         nxt_rw = .Range("A65536").End(xlUp).Row + 1
        'Sample Date
        .Range("B" & nxt_rw).Value = ActiveCell.Offset(0, 1)
        'Sample ID
        .Range("A" & nxt_rw).Value = ActiveCell.Offset(0, 2)
    End With

... as long as all of the next set of data goes onto the same row, we can just find the next blank row once, and refer to the ranges using this row number; we've then saved your code having to search for the last-used row on the "Atmospheric" sheet every time it posts another piece of data accross.
Should improve things dramatically!

 

[dejamls]

Pleasure! Has it improved your project?

Out of interest, in your "Atmospheric" worksheet, does all the data always finish on the same row? - i.e. when the code fires, is it going along the same row, and pushing the data into the various cells of that next available row? I'm assuming that it does.
If this IS the case, then we could speed things up AND further reduce your code - quite significantly:

Dim wsDestA As Worksheet 'Destination workbook + sheet
Dim nxt_rw As Long

Set wsDestA = Workbooks("SRS Bulk Sample Lodgement.xlsm").Worksheets("Atmospheric") 'Destination workbook + sheet
    
    With wsDestA
         nxt_rw = .Range("A65536").End(xlUp).Row + 1
        'Sample Date
        .Range("B" & nxt_rw).Value = ActiveCell.Offset(0, 1)
        'Sample ID
        .Range("A" & nxt_rw).Value = ActiveCell.Offset(0, 2)
    End With

... as long as all of the next set of data goes onto the same row, we can just find the next blank row once, and refer to the ranges using this row number; we've then saved your code having to search for the last-used row on the "Atmospheric" sheet every time it posts another piece of data accross.
Should improve things dramatically!

Hi sykes, yes the previous code you gave me helped improve the speed quite a lot. I will try your next gem tomorrow and let you know how it goes. Many thanks for your help.

 

[sykes]

Pleasure. Thanks for the feedback.

 

[dejamls]

Hi sykes

Tested your latest recommendation. Your improved code worked really good and executes much faster now. Really appreciate your assistance.

Cheers

 

[sykes]

Pleasure, thanks.