VBA Hjælp - Kopier flere celler til en celle, med eksakt match

Vil der være data uden huller i J i ark1 og R i ark2
for ellers bliver det en laaaaaaaaaaaaangsom en

Hej Nelson,

der er 2 skjulte felter i mellem i kolonne J i ark1.

Kolonerne R:Z i Ark2 er uden huller.

Kan man gøre noget andet da??

Hilsen Simon

Altså 2 skjulte rækker i Ark1?

Så skulle denne virke:
Sub pr()
Worksheets("ark2").Select
Range("r1").End(xlDown).Select
xtaeller = ActiveCell.Row
Worksheets("Ark1").Select
Range("j1").End(xlDown).Select
Ytaeller = ActiveCell.Row
For Each y In Range("j1:j" & Ytaeller)
    For Each x In Worksheets("ark2").Range("r1:z" & xtaeller)
            If x = y Then
                hente = hente & x & ","
            End If
    Next
            If hente <> "" Then
                hente = Left(hente, Len(hente) - 1)
                RR = y.Row
                Range("y" & RR).Value = hente
            End If
hente = ""
Next
End Sub

Fedt prøver den af i aften. Ja der er 2 skjulte rækker i mellem i ark1

Så skriver lige når jeg har prøvet den af :)

Fantastisk den virker næsten : )

Men den skal ikke hente indholdet i r1:z men fra kolonne a i ark2

men har lige 2 spørgsmål:

1. Er det muligt at den kan hente
kolonne a ark2 til kolonne y ark1
kolonne b ark2 til kolonne z ark1
kolonne c ark2 til kolonne aa ark1 og slut

2. hvordan tilføjer man flere ark der hvor Ark1 står i koden?

Tusind tak for hjælpen Nelson :)

Er ikke helt klar over hvad du mener med tilføjer flere ark ?

Sub pr()
Worksheets("ark2").Select
Range("r1").End(xlDown).Select
xtaeller = ActiveCell.Row
Worksheets("Ark1").Select
Range("j1").End(xlDown).Select
Ytaeller = ActiveCell.Row
For Each y In Range("j1:j" & Ytaeller)
    For Each x In Worksheets("ark2").Range("r1:z" & xtaeller)
            If x = y Then
            AR = y.Row
                ahente = ahente & Worksheets("Ark2").Range("a" & AR).Value & ","
                bhente = bhente & Worksheets("Ark2").Range("b" & AR).Value & ","
                chente = chente & Worksheets("Ark2").Range("c" & AR).Value & ","
            End If
    Next
            If ahente <> "" Then
                ahente = Left(ahente, Len(ahente) - 1)
                Range("y" & AR).Value = ahente
            End If
            If bhente <> "" Then
                bhente = Left(bhente, Len(bhente) - 1)
                Range("z" & AR).Value = bhente
            End If
            If chente <> "" Then
                chente = Left(chente, Len(chente) - 1)
                Range("aa" & AR).Value = chente
            End If
ahente = ""
bhente = ""
chente = ""

Next
End Sub

det begynder at ligne noget, men synes ikke rigtig jeg kan få den til at virke som den skal.

Men kan først kigge på det i aften desværre...

Så må lige vende tilbage. Du har næsten løst et kæmpe problem for mig, så tak for det.

Håber det er okay.

Ups der var en smutter
Sub pr()
Worksheets("ark2").Select
Range("r1").End(xlDown).Select
xtaeller = ActiveCell.Row
Worksheets("Ark1").Select
Range("j1").End(xlDown).Select
Ytaeller = ActiveCell.Row
For Each y In Range("j1:j" & Ytaeller)
    For Each x In Worksheets("ark2").Range("r1:z" & xtaeller)
            If x = y Then
            AR = x.Row
                ahente = ahente & Worksheets("Ark2").Range("a" & AR).Value & ","
                bhente = bhente & Worksheets("Ark2").Range("b" & AR).Value & ","
                chente = chente & Worksheets("Ark2").Range("c" & AR).Value & ","
            End If
    Next
    RR = y.Row
   
            If ahente <> "" Then
                ahente = Left(ahente, Len(ahente) - 1)
                Range("y" & RR).Value = ahente
            End If
            If bhente <> "" Then
                bhente = Left(bhente, Len(bhente) - 1)
                Range("z" & RR).Value = bhente
            End If
            If chente <> "" Then
                chente = Left(chente, Len(chente) - 1)
                Range("aa" & RR).Value = chente
            End If
ahente = ""
bhente = ""
chente = ""

Next
End Sub

Ja det var det der skulle  til - Tusind tusind tak

Smid lige et svar, så jeg kan give dig point : )

Hilsen Simon

fint det virkede