Find Rows and Copy to new worksheet

[Dummy Excel]

Hi All,
I need to find a unique cell in my summary worksheet and then copy to a new worksheet
I have had a go to try and do this although the header row (row 1) copies fine, although the rest of the data pastes in the last row 1 of the spreadsheet. can anyone help?
The unique data is (G512, G515, G521, G532, S313, VL362). as this is a daily report, the unique data may not always be in the summary worksheet.

Sub VIC_Report()
    Sheets("Sheet3").Name = "VIC Report"
    
    Rows("1:1").Copy
    Sheets("VIC Report").Range("A1").PasteSpecial

    'FIltering VIC Locos
    Cells.Find(What:="G532", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    Range(Selection, Selection.End(xlToRight).Offset(0, 9)).Copy
    Sheets("VIC Report").Select
    Cells(Rows.Count, "A").End(xlDown).PasteSpecial
    
End Sub

your help is greatly appreciated
thanks
Sam

 

[Dummy Excel]

bump??

 

[Smitty]

I'd use End(xlUp) as it's less error prone, then add Offset(1) to move to the first empty row. Without the Offset your code is pasting to the last populated row.

Sheets("VIC Report").Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial

But copying data to other sheets is really inefficient; just use Pivot Tables. Then there's no need to keep copying as new data is added, you just refresh.

HTH,

 

[Smitty]

BTW - If you're in Sydney, you might want to check this out:

https://www.eventbrite.co.uk/e/excel-summit-south-2016-sydney-tickets-19143404438

 

[Dummy Excel]

thanks Smitty
im also trying to search for unique data in column A (eg G532, VL362, S313) and copy a few columns. the issue i have is that unquie data might not always be there.
my code is

    lr = Cells(Rows.Count, "A").End(xlUp).Row
        For r = 1 To lr
    If Cells(r, lr).Value = G515 Then
    Range(r, 0).End(xlToRight).Offset(0, 9).Copy
    Sheets("VIC Report").Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial
        Else
    If Cells(r, lr).Value = VL362 Then
    Range(r, 0).End(xlToRight).Offset(0, 9).Copy
    Sheets("VIC Report").Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial
    
    End If
    End If
    Next r

appreciate your help