VBA copy paste array/range onto another tab - vba

Question

Im trying to copy specific rows in a long list containing certain titles onto its own tab.
I had a system that worked using entirerow.copy Destination:= but this was quite untidy and took very long as I had a runclick to work with over 10 modules at once (which had to work with over 3500 rows.
So far I have this but I know the paste part is missing (I'm unsure what to put essentially). This basic format worked very well for me in another macro for formatting cells but obviously it is not quite the same.
Sub Anasuria()
Dim i As Long, LastRow As Long
Dim phrases
Dim rng1 As Range
With Application
.ScreenUpdating = False
.DisplayStatusBar = False
.Calculation = xlCalculationManual
End With
Sheets("Anasuria").Range("A40:AZ10000").ClearContents
phrases = Array("ANASURIA-Central", "ANASURIA-Env. Trading Sys.", "ANASURIA-Fulmar", _
"COOK-Anasuria allocation", "GUILLEMOT-Fulmar Gas")
With Sheets("Main")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
For i = 40 To LastRow
If Not IsError(Application.match(.Range("A" & i).Value, phrases, 0)) Then
If rng1 Is Nothing Then
Set rng1 = Sheets("Anasuria").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
End If
rng1.PasteSpecial
Next i
End With
With Application
.Calculation = xlCalculationAutomatic
.DisplayStatusBar = True
.ScreenUpdating = True
End With
End Sub
Basically I want the relevant rows to be copied into the "Anasuria" sheet starting at row i.

Answer 1

I have modified your code a little and it should work (just edit range to your needs). One more thing: did you think of using advanced filter? I think it would give you the same results.
Sub Anasuria()
Dim i As Long, LastRow As Long, LastRowAna As Long
Dim phrases
With Application
.ScreenUpdating = False
.DisplayStatusBar = False
.Calculation = xlCalculationManual
End With
Sheets("Anasuria").Range("A1:AZ10").ClearContents
phrases = Array("ANASURIA-Central", "ANASURIA-Env. Trading Sys.", "ANASURIA-Fulmar", _
"COOK-Anasuria allocation", "GUILLEMOT-Fulmar Gas")
LastRow = Sheets("Main").Range("A" & Rows.Count).End(xlUp).Row
LastRowAna = Sheets("Anasuria").Range("A" & Rows.Count).End(xlUp)
For i = 1 To LastRow
If Not IsError(Application.Match(Sheets("Main").Range("A" & i).Value, phrases, 0)) Then
Sheets("Main").Range("A" & i).EntireRow.Copy Sheets("Anasuria").Range("A" & LastRowAna + 1) 'copy/paste part you needed ;)
LastRowAna = LastRowAna + 1
End If
Next i
With Application
.Calculation = xlCalculationAutomatic
.DisplayStatusBar = True
.ScreenUpdating = True
End With
End Sub