VBA copy paste array/range onto another tab

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.

have you seen [**THIS**](http://stackoverflow.com/questions/18481330/2-dimensional-array-from-range/18481730#18481730)? It seems like a much easier approach — , Jun 25 '14 at 13:18
@me how Isnt this for copying a whole range? I'm looking for copying specific rows that have a certain title that are completely random? I could be wrong as I'm still relatively new to this! — sim08, Jun 25 '14 at 13:22
you wrote, Paste part is missing. I see Copy part missing, could you confirm? — avb, Jun 25 '14 at 14:47

lowak · Accepted Answer · 2014-06-26T07:08:08.653

0

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

edited Jun 26 '14 at 07:08

answered Jun 26 '14 at 06:30

lowak

1,254
2
18
38

I had considered this initially but I wasnt entirely sure it would work with an increasing range without having to change the criteria manually. Would I be correct in thinking that? Either way thanks for the help, managed to cut the running time by over a minute with this. – sim08 Jun 26 '14 at 08:18
Ive realised you can use a dynamic range which can automatically change if new cells are added, so thanks for the info! – sim08 Jun 26 '14 at 09:03
`LastRow = .Range("A" & Rows.Count).End(xlUp).Row` is still wrong, i guess a dot is needed before rows or it will count on activesheet. On the original code, : `LastRow = .Range("A" & .Rows.Count).End(xlUp).Row` – Patrick Lepelletier Jun 27 '14 at 16:20
look at the code, my variable is `LastRow = Sheets("Main").Range("A" & Rows.Count).End(xlUp).Row` not as you pointed `LastRow = Range("A" & Rows.Count).End(xlUp).Row` – lowak Jun 28 '14 at 09:03

VBA copy paste array/range onto another tab

1 Answers1