sortere navne udfra krydser og skrive dem på listeform

Ja - det skulle nok være muligt..

Hvor mange data skal med på de enkelte ark?

Rem Kode anbringes under Ark1
rem De 3 næste ark omdøbes til "gruppe1", "gruppe2" og "gruppe3"

Dim antalRæk As Long, ræk As Long
Dim navn As String, klasse As String
Dim arkNavn As String, ræk1 As Long, ræk2 As Long, ræk3 As Long
Dim kryds As Byte
Public Sub sorterElever()
    Application.ScreenUpdating = False
   
    antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
    ræk1 = 0
    ræk2 = 0
    ræk3 = 0
   
    For ræk = 2 To antalRæk
        række = findKrydsOgRække(ræk)
        placerElev arkNavn, Range("D" & ræk), Range("E" & ræk), række
    Next ræk
   
    Application.ScreenUpdating = True
End Sub
Private Function findKrydsOgRække(ræk)
    If LCase(Range("A" & ræk)) = "x" Then
        arkNavn = Cells(1, 1)
        ræk1 = ræk1 + 1
        findKrydsOgRække = ræk1
    Else
        If LCase(Range("B" & ræk)) = "x" Then
            arkNavn = Cells(1, 2)
            ræk2 = ræk2 + 1
            findKrydsOgRække = ræk2
        Else
            findKryds = 3
            arkNavn = Cells(1, 3)
            ræk3 = ræk3 + 1
            findKrydsOgRække = ræk3
        End If
    End If
End Function
Private Sub placerElev(arkNavn, navn, klasse, række)
    Sheets(arkNavn).Activate
    ActiveSheet.Range("A" & række) = navn
    ActiveSheet.Range("B" & række) = klasse
    række = rækk + 1
    Sheets("Ark1").Activate
End Sub

Manuelt:
marker overskrifter, gruppe1  gruppe2  gruppe3  navne  klasse
Vælg 'Data' --> 'Filter' --> 'Autofilter'

Filtrer gruppe1 --> vælg "x" --> Kopier kolonne D(navne) og E(klasse)
på ark2 højreklik i celle A1 --> 'Sæt ind'
Tilbage til listen, klik på gruppe1, Filtrer gruppe1 --> vælg "alle"

Filtrer gruppe2 --> vælg "x"--> Kopier kolonne D(navne) og E(klasse)
på ark3 højreklik i celle A1 --> 'Sæt ind'
Tilbage til listen, klik på gruppe2, Filtrer gruppe2 --> vælg "alle"

Filtrer gruppe3 --> vælg "x" --> Kopier kolonne D(navne) og E(klasse)
på ark4 højreklik i celle A1 --> 'Sæt ind'
Tilbage til listen, klik på gruppe3, Filtrer gruppe1 --> vælg "alle"

Hej, tak for forslaget. Jeg har klistret koden ind i ark1 og omdøbt de næste 3 ark til gruppe1, gruppe2 og gruppe3, men når jeg kører koden siger den, "subscript out of range".
hvad gør jeg mon forkert

Hilsen Allan

Prøv at checke "Gruppeoverskrifterne" og arknavnene er de ens?

de er ens.
Mhh, så jeg ved ikke lige....

Ok - du er velkommen til at sende filen til. @-adresse under min profil.

Rem "Version 2"
Dim antalRæk As Long, ræk As Long
Dim navn As String, klasse As String
Dim arkNavn As String, rækkeTabel(8) As Integer
Dim kryds As Byte
Public Sub sorterElever()
    Application.ScreenUpdating = False
   
    nulstilTabel
   
    antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
   
    For ræk = 3 To antalRæk                        'START I RÆKKE 3
        række = findKrydsOgRække(ræk)
        If række > 0 Then
            placerElev arkNavn, Range("I" & ræk), Range("J" & ræk), række
        End If
    Next ræk
   
    Application.ScreenUpdating = True
    MsgBox "Sortering afsluttet"
End Sub
Private Sub nulstilTabel()
Dim k As Byte
    For k = 0 To 8
        rækkeTabel(k) = 1
    Next k
End Sub
Private Function findKrydsOgRække(ræk)
Dim k As Byte
    For k = 1 To 8
        If Cells(ræk, k) = "x" Then
            arkNavn = "GR" & CStr(k)
            rækkeTabel(k) = rækkeTabel(k) + 1
            findKrydsOgRække = rækkeTabel(k)
            Exit Function
        End If
    Next k
    findKrydsOgRække = 0
End Function
Private Sub placerElev(arkNavn, navn, klasse, række)
    Sheets(arkNavn).Activate
    ActiveSheet.Range("A" & række) = navn
    ActiveSheet.Range("B" & række) = klasse
    ActiveSheet.Columns.AutoFit
   
    Sheets("Ark1").Activate
End Sub

Takker.
Det er helt perfekt...

Selv tak..