Sorter/flyt data til nyt ark udfra givne kriterier

Prøv denne:

Sub Test()
Dim Slut As Long, I As Long, Y As Long, MitArray, Val As Variant, Val2

Sheets("Ark1").Select
Slut = Range("A65536").End(xlUp).Row
MitArray = Range("A1:O" & Slut)

Sheets("Ark2").Select
For I = 1 To UBound(MitArray)
    D = 0
    Val = MitArray(I, 1) & MitArray(I, 2) & MitArray(I, 3) & MitArray(I, 4) & MitArray(I, 5) & MitArray(I, 6) & MitArray(I, 7) & MitArray(I, 8)
    Ende = Range("A65536").End(xlUp).Row + 1
    Z = 0
   
    On Error Resume Next
    If Z = 0 Then
        For Z = 1 To 9 'UBound(MitArray, 2)
            Cells(Ende, Z).Value = MitArray(I, Z)
        Next
    End If
   
    For Y = I + 1 To I + 7
        Val2 = MitArray(Y, 1) & MitArray(Y, 2) & MitArray(Y, 3) & MitArray(Y, 4) & MitArray(Y, 5) & MitArray(Y, 6) & MitArray(Y, 7) & MitArray(Y, 8)
       
        If Val = Val2 Then
            D = D + 1
            Cells(Ende, D + 9).Value = MitArray(Y, 9)
        Else
            Ende = Range("A65536").End(xlUp).Row + 1
            GoTo næste
        End If
    Next
næste:
    I = I + D
Next

Sheets("Ark1").Select
End Sub

Tak for løsningsforslaget...
Det er et godt forsøg, der stort set virker.

Der er lige et problem + et par kosmetiske fejl.

Problem:
Der kan godt være flere end 8 rækker der er ens fra kolonne A til H. Dvs. at jeg kan komme ud for at skulle have måske 12 eller 20 nye kolonner i en række.
Den nuværende løsning giver 8 nye kolonner, og så kommer der en ny række med 3 kolonner, i et tilfælde hvor der er 12 ens rækker...
Vil gerne have at den selv finder ud af hvor mange kolonner der er brug for. Hvis det er for besværligt, så vil jeg gerne have, at der kan laves op til 20 kolonner i stedet for 8.

Hvis dette problem løses, så er pointene hjemme.

Kosmetiske fejl:
- Linie 1 i Ark2 bliver blank, og så kommer kolonneoverskrifterne først i linie 2.
Kan det ændres, så det hele rykkes op, dvs. der ikke er nogen blank linie?
- Kan man få kopieret kolonneoverskriften fra "I1" i Ark1 med over til alle de nye kolonner i Ark2? ("I1 til "antal brugte kolonner" eller "AB1")

Hvis dette også kommer med, er det bare kanon.

Og hvis du er rigtig serviceminded, så må du meget gerne skrive lidt kommentarer til dit "program" omkring hvad der sker, så jeg kan lære lidt af det. Det er ikke så længe siden jeg er begyndt at bruge lidt Visual Basic, så jeg prøver at forstå hvad der sker...

Har lige fundet ud af, at den minimum skal kunne håndtere 25 brugere... - altså 25 nye kolonner... - så løsningen skal som sagt helst selv kunne finde ud af hvor mange kolonner der skal dannes - alternativt, kunne det være hensigtsmæssigt, med en lille vejledning i hvad jeg skal ændre, for at antallet af nye kolonner kan sættes op - så jeg selv kan gøre det, hvis behovet skulle stige...

PFT

Prøv med denne:

Sub Test()
Dim Slut As Long, I As Long, Y As Long, MitArray, Val As Variant, Val2

Sheets("Ark1").Select
Slut = Range("A65536").End(xlUp).Row 'Finder nederste celle der er skrevet i
MitArray = Range("A1:O" & Slut) 'Laver et array vi kan søge i

Sheets("Ark2").Select
For I = 1 To UBound(MitArray)
    D = 0
   
    'Val er en sammensætning af værdierne fra A til H
    Val = MitArray(I, 1) & MitArray(I, 2) & MitArray(I, 3) & MitArray(I, 4) & MitArray(I, 5) & MitArray(I, 6) & MitArray(I, 7) & MitArray(I, 8)
    Ende = Range("A65536").End(xlUp).Row + 1 'Find første tomme række
    If Ende = 2 And Range("A1").Value = "" Then 'Da første række kan snyde hvis der er indsat en række i forvejen, må vi checke om der er skrevet noget i A1
        Ende = 1
    End If
    Z = 0
   
    On Error Resume Next
    If Z = 0 Then 'Hvis det er en ny række, gøres klar til at skrive i ark2
        For Z = 1 To 9 'Udfylder kolonne A til I i den nye række i ark2 (I = kolonne 9)
            Cells(Ende, Z).Value = MitArray(I, Z)
        Next
    End If
   
    For Y = I + 1 To UBound(MitArray) 'Check fra rækken uder den række der arbejdes med. Den tæller ikke 25 ned, men helt til bunden, hvis det er nødvendigt
       
        'Val2 er en sammensætning af værdierne fra A til H
        Val2 = MitArray(Y, 1) & MitArray(Y, 2) & MitArray(Y, 3) & MitArray(Y, 4) & MitArray(Y, 5) & MitArray(Y, 6) & MitArray(Y, 7) & MitArray(Y, 8)
       
        If Val = Val2 Then 'Hvis værdierne er ens
            D = D + 1 'tæller vi op hvor mange rækker der er end nedenunder
            Cells(Ende, D + 9).Value = MitArray(Y, 9) 'og skriver i J, K, L o.s.v.
        Else
            Ende = Range("A65536").End(xlUp).Row + 1 'Når vi kommer til række der ikke er identisk
            GoTo næste 'springer vi til næste gennemløb
        End If
    Next
næste:
    I = I + D 'Vi lægger antallet af fundne rækker til I, så næste søgning foregår derunder
Next

Sheets("Ark1").Select
End Sub


"- Kan man få kopieret kolonneoverskriften fra "I1" i Ark1 med over til alle de nye kolonner i Ark2? ("I1 til "antal brugte kolonner" eller "AB1")"
den er jeg ikke helt sikker på at jeg forstår...

Tja, hvad skal jeg skrive - det er jo genialt.
Der går nok lige lidt tid inden jeg lærer at lave så avancerede løsninger...:-)

Men 1000 tak for hjælpen og for kommentarerne.
Du har fortjent pointene - så læg et svar!

Hvis du vil prøve at lave den sidste ting til mig, så er det jeg mener:
I mit Ark1 i feltet "I1" er der et tekstfelt hvor der står "bruger" - Dette felt kunne jeg godt tænke mig blev kopieret med over i Ark2 - så det kommer til at stå i felterne "I1", "J1", "K1" osv. - lige så mange kolonner ud, som der kommer data i.
Dvs. at alle kolonner fra kolonne "I" får samme tekst i række 1.
Håber det er forståeligt - Hvis ikke det er muligt, så glem det. Det er ikke så vigtigt. - Kan jo hurtigt kopieres ud manuelt.

Velbekomme :-)

Jeg tror stadig ikke jeg er helt med på, hvad det er du vil. Vil det sige der er overskrifter i Ark1 - række1?

I så fald skal du ændre
MitArray = Range("A1:O" & Slut) 'Laver et array vi kan søge i
til
MitArray = Range("A2:O" & Slut) 'Laver et array vi kan søge i

og ændre Cells(Ende, D + 9).Value = MitArray(Y, 9) 'og skriver i J, K, L o.s.v.
til
Cells(Ende, D + 9).Value = Sheets("Ark1").Range("I1").Value 'og skriver i J, K, L o.s.v.

Men så kommer alle felter i ark2 fra I1 og frem, samt nedad til at have samme værdi.

Hvis ikke forstået, må du forklare nærmere ;-)

Ja, det er korrekt, at der er overskrifter i Ark1 - række1, men det har ikke givet nogle problemer...
Mht. til at kopiere overskriften fra "I1" i Ark1 til "I1" og fremefter i Ark2, så dropper vi det bare. Det er hurtigt gjort manuelt.

Jeg prøvede lige en enkelt gang med din seneste kode, men så kom teksten fra "I1" til at stå en forfærdelig masse steder (vist alle steder, hvor der skulle have været et brugernr. fra og med Kolonne J) + at de øvrige kolonneoverskrifter ("A1:H1") kommer ikke med...

Tak for point. Det var også sådan jeg tolkede det, og kunne ikke få det til at passe det skulle laves sådan.