Speed up VBA code on extracting relevant rows to new worksheet - excel

Question

I need to copy relevant rows to a new Excel worksheet. The code will loop through each row in the original worksheet and select rows based on relevant countries and products specified in the array into the second worksheet.
Private Sub CommandButton1_Click()
a = Worksheets("worksheet1").Cells(Rows.Count, 2).End(xlUp).Row
Dim countryArray(1 To 17) As Variant
Dim productArray(1 To 17) As Variant
' countryArray(1)= "Australia" and so on...
' productArray(1)= "Product A" and so on...
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For i = 3 To a
For Each j In countryArray
For Each k In productArray
Sheets("worksheet1").Rows(i).Copy Destination:=Sheets("worksheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
Next
Next
Next
Application.CutCopyMode = False
Application.ScreenUpdating = False
End Sub
Each time I ran the code, the spreadsheet stopped responding in a matter of minutes. Would appreciate if someone could help me on this, thanks in advance!

Answer 1

Here are some pointers:
Remember to declare all your variables and use Option Explicit at the top of your code
Use With statements to ensure working with right sheet and not implicit activesheet or you may end up with wrong end row count
Only i contributes to the loop so you are making unnecessary loop work
Gather qualifying ranges with Union and copy in one go
Remember to switch back on screen-updating
Code:
Option Explicit
Private Sub CommandButton1_Click()
Dim unionRng As Range, a As Long, i As Long
With Worksheets("worksheet1")
a = .Cells(.Rows.Count, 2).End(xlUp).Row
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For i = 3 To a
If Not unionRng Is Nothing Then
Set unionRng = Union(unionRng, .Cells(i, 1))
Else
Set unionRng = .Cells(i, 1)
End If
Next
With Worksheets("worksheet2")
unionRng.EntireRow.Copy .Cells(.Rows.Count, "A").End(xlUp).Row +1
End With
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub