Itt a makró, amiben feltételezem, hogy az összes adatot tartalmazó lap neve Összes, a többi lapé pedig a tulajdonság nevével megegyező (jó, okos, szamár), és az Összes lapon ez a tulajdonság a B (2.) oszlopban szerepel.

Sub Lapokra()
    Dim sor, lapn
    Sheets("Összes").Select
   
    For sor = 2 To ActiveSheet.UsedRange.Rows.Count
        lapn = Cells(sor, 2) 'Itt veszi az adatot a B oszlopból)
        Rows(sor).Copy
        Sheets(lapn).Select
        Cells(Range("A65536").End(xlUp).Row + 1, 1).Select
        ActiveSheet.Paste
        Sheets("Összes").Select
    Next
End Sub