Need help with getting list of data from unique row

[JackkG]

Hi,

I got unique Ticker values with Frequency=1 in Sheet 2. I want to query these unique values where all the related data in Sheet 1 should be copied in Sheet 3. The sample sheet is attached for better understanding.

In Sheet 2 (Test sheet), you can see unique Ticker value for author where frequency=1. I want help in querying the data in such a way that all the yellow highlighted instances in Sheet 1 (List sheet) should be copied to Sheet 3 (Test2).

Can anyone help me with the VBA query or any formula to achieve this will be great!

Thanks!

[mancubus]

try:

remove xlPasteValues to copy formats and formulas!

Sub filter_copy()
    Dim i As Long, LastRow As Long

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Worksheets("Test2").UsedRange.Offset(1).ClearContents
    
    With Worksheets("List")
        .AutoFilterMode = False
        For i = 2 To Worksheets("Test").Range("C" & Rows.Count).End(xlUp).Row
            LastRow = Worksheets("Test2").Range("C" & Rows.Count).End(xlUp).Offset(1).Row
            .Cells(1).AutoFilter Field:=3, Criteria1:=Worksheets("Test").Range("C" & i)
            .AutoFilter.Range.Offset(1).Resize(.AutoFilter.Range.Rows.Count - 1, 7).Copy
            Worksheets("Test2").Range("A" & LastRow).End(xlUp).Offset(1).PasteSpecial xlPasteValues
            .AutoFilter.Range.Offset(1, 8).Resize(.AutoFilter.Range.Rows.Count - 1, 1).Copy
            Worksheets("Test2").Range("H" & LastRow).PasteSpecial xlPasteValues
        Next i
        .AutoFilterMode = False
    End With

    With Application
        .EnableEvents = True
    End With

End Sub

[gmayor]

How about?

Sub CopyHighlighted
Dim xlSource As Worksheet
Dim xlTarget As Worksheet
Dim NextRow As Long
Dim LastRow As Long
Dim i As Long
    Set xlSource = ActiveWorkbook.Sheets("List")
    Set xlTarget = ActiveWorkbook.Sheets("Test2")
    LastRow = xlSource.Cells(xlSource.Rows.Count, "A").End(xlUp).Row
    For i = 2 To LastRow
        If xlSource.range("A" & i).Interior.Color = RGB(255, 255, 0) Then
            NextRow = xlTarget.Cells(xlTarget.Rows.Count, "A").End(xlUp).Row + 1
            xlSource.range("A" & i, "J" & i).Copy
            xlTarget.range("A" & NextRow, "J" & NextRow).PasteSpecial xlPasteValues
        End If
    Next i
End Sub

[apo]

Here's another...

Private Sub CommandButton1_Click()
    With range("A1").CurrentRegion
        .AutoFilter 3, Application.Transpose(Sheets(2).range("C2:C" & Sheets(2).range("C" & Rows.Count).End(xlUp).Row)), 7
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(12).Copy
        Sheets(3).range("A" & Sheets(3).range("A" & Rows.Count).End(xlUp).Row).Offset(1).PasteSpecial -4163
    End With
End Sub

[JackkG]

Hi mancubus and apo,

Thanks for your help, your solution really works great!

gmayor, the yellow highlighted color was just for understanding purpose, but anyway thanks for your help too!

Thanks guys, really appreciate your work!

[JKwan]

Is this what you ultimately wanted?

[JKwan]

goto your List tab and click on a name