Trying to extract data from one sheet to another

[Michelle2175]

Hello there!

Please see my attached example spreadsheet. I am trying to extract data from the "Master List" sheet into the "Soccer" sheet.

I would like the Name, Age, Sport, Jersey Colour and Date Played to automatically populate into the "Soccer" sheet for all the kids who play soccer.

I know I could autofilter the "Master Sheet" and then copy and paste the data into the a new sheet but I would like to know if this could happen automatically... even as I put more entries into my "Master List".

Thanks in advanced!
Michelle

[NBVC]

In a free cell on the Master tab, enter a formula that counts the number of Soccers... so say in G2 you enter:

=COUNTIF($C$2:$C$13,"Soccer")

this will be used in next formula.

then in A2 of the Soccer tab enter:

=IF(ROWS($A$1:$A1)>'Master List'!$G$2,"",INDEX('Master List'!$A$2:$A$13,SMALL(IF('Master List'!$C$2:$C$13="Soccer",ROW('Master List'!$A$2:$A$13)-ROW('Master List'!$A$2)+1),ROWS($A$1:$A1))))

confirmed with CTRL+SHIFT+ENTER, not just ENTER and copy down as far as you need to extract all possibilities and more....

Then in B2, enter:

=IF(A2="","",INDEX('Master List'!B$2:B$13,MATCH($A2,'Master List'!$A$2:$A$13,0)))

and copy down and across the rest of the table.

Note: If you adjust ranges in the first large formula, you will need to re-confirm it with CTRL+SHIFT+ENTER first, then copy down again.

[Marcol]

Try this to start with.

Option Explicit

Sub CutAndPasteRow(FindWhat As String, Optional StartCell As String = "A2")
    Dim LastRow As Long, RowNo As Long, PasteRow As Long
    
    Application.ScreenUpdating = False
    On Error GoTo ResetApplication
    
    LastRow = Sheets("Master List").UsedRange.Rows.Count
    If Sheets("Soccer").Range("A1") = "" Then
        Rows(1).Copy Worksheets("Soccer").Cells(1, 1)
        PasteRow = 1
    Else
        PasteRow = Sheets("Soccer").Range("A" & Rows.Count).End(xlUp).Row
    End If
    
    For RowNo = Range(StartCell).Row To LastRow
        RowNo = Cells.Find(What:=FindWhat, After:=Range(StartCell), LookIn:=xlValues).Row
        PasteRow = PasteRow + 1
        Rows(RowNo).Cut Worksheets("Soccer").Cells(PasteRow, 1)
    Next
    
ResetApplication:
    Application.ScreenUpdating = True
    On Error GoTo 0
End Sub

Sub FindWhatCutAndPasteRow()
    CutAndPasteRow "Soccer"
End Sub

We can modify this quite easily to delete blank rows, but updating as you go may need a bit of clarification.