VBA- Ammend code from Copy and paste to destination - vba

Question

my code is running really slowly and I'm trying to fasten it. The only way I can think of is to do without the last bit of code which does copy, select,paste twice for two different target worksheets. Was wondering if I'm able to change it to something like Destination:= ____ & ____ instead of selecting and pasting twice?
Sub compare()
'compare if the values of two ranges are the same
'Select workbook to prevent mismatch error
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Workbooks("Compare.xlsm").Activate
Dim referencesheetname, newsheetname, outputsheetname As String
referencesheetname = "Reference"
newsheetname = "New"
Dim range1, range2 As Range
'define the variables
Dim referencesheetcols As Integer
Dim range1rows, range1cols, range2rows, range2cols, testrows, testcols, i, j, p, q As Long
Dim bMatches, rowmatched As Boolean
Dim product As String
'Define names for easy reference
product = "Ethylene"
'Set range you wish the macro to search up till
newsheetcols = 3000
referencesheetcols = 3000
'How many rows and columns should we compare?
'Set testcols to 150 to test whole range
testrows = 1
testcols = 200
'Set p for position to place data at (i.e. if p=1, data will be pasted)
p = Sheets(referencesheetname).UsedRange.Rows.Count
q = Sheets("Datasheet").UsedRange.Rows.Count
'Pasted table range data starts from row 7
For l = 1 To newsheetcols
'ActiveWorkbook.Worksheets(newsheetname).Select
'only test if correct product down column B
If CStr(Sheets(newsheetname).Rows(l).Cells(1, 2).Value) = product Then
rowmatched = False
For k = 5 To referencesheetcols
'bmatch = False
'Define range compare rows 6 onwards for both sheets
Set range1 = Sheets(referencesheetname).Rows(k)
Set range2 = Sheets(newsheetname).Rows(l)
' count the rows and columns in each of the ranges
range1rows = range1.Rows.Count
range1cols = range1.Columns.Count
range2rows = range2.Rows.Count
range2cols = range2.Columns.Count
'Check if ranges are the same dimension?
bMatches = (range1rows = range2rows And range1cols = range2cols)
'if same dimensions loop through the cells
If bMatches Then
For i = 1 To testrows
For j = 1 To testcols
If (range1.Cells(i, j).Value <> range2.Cells(i, j).Value) Then
'Conclude that range dimension is not the same
bMatches = False
i = testrows
j = testcols
'Exit loops
End If
Next
Next
End If
'If ranges of two comparison sheets are the same
If bMatches Then
rowmatched = True
k = referencesheetcols
End If
'Sheets(outputsheetname).Cells(1, 1).Value = rowmatched
'Set place to paste data
If (Not (rowmatched) And k = referencesheetcols) Then
'Copy and paste specified number of columns
range2.Resize(1, 300).Copy
Sheets(referencesheetname).Cells(p, 1).Offset(2, 0).Select
ActiveSheet.Paste
p = p + 1
Sheets("Datasheet").Activate
ActiveSheet.Cells(q, 1).Offset(2, 1).Select
ActiveSheet.Paste
q = q + 1
End If
Next
End If
Next
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
End Sub

Answer 1

Something like below should be ok to change to copy - destination.
range2.Resize(1, 300).Copy Destination:=Sheets(referencesheetname).Cells(p, 1).Offset(2, 0)
Although if you really wanted to speed up your code I would say you would need to read the range into an array and then do your processing on the array. looking at the sheet is costly in terms of cpu time, selecting should be avoided where ever possible
You could also turn calculation off and just recalc when you need it too. You could also look up "WITH"'s as these can speed it up a bit too