Søge i celler efter tekst eller tal og kun kopier celler med indhold til andet ark

Jeg mangler måske lige at skrive: Det er vigtigt at herakiet på det nye ark bliver, at første celle fundet bliver placeret på A1, næste celle fundet A2 osv

Sub tst()
For Each c In Range("AA1:AA78")
Set sh1 = Sheets("Ark3") ' kilde ark - ret til aktuel
Set sh2 = Sheets("Ark4") ' destinations ark - ret til aktuel
rk = sh2.Cells(65000, "AA").End(xlUp).Row + 1
If c = "info" Then sh1.Range("A" & c.Row & ":IV" & c.Row).Copy sh2.Range("A" & rk)
Next
End Sub

Rent held hvis den virker med de sparsomme oplysninger

Hej excelent
ja heldige var vi ikke ;-)

Den kopier ikke kun fra AA, men tager oplysninger med fra resten af kolonnerne.

Den læser altså altså godt nok om der står en værdi i en celle i AA, men den kopier ikke kun den pågældende celle og aflevere den til A2 på det andet ark

Sub Linier()

For Each c In Range("AA1:AA78")
Set sh1 = Sheets("MH") ' kilde ark - ret til aktuel
Set sh2 = Sheets("Til variant") ' destinations ark - ret til aktuel
rk = sh2.Cells(65000, "AA").End(xlUp).Row + 1
If c > 1 Then sh1.Range("A" & c.Row & ":IV" & c.Row).Copy sh2.Range("A" & rk)
Next
End Sub

Er det evt at rk er sat til at være = sh2, burde det ikke være sh1?

Håber du kan hjælpe

ok så prøv

Sub Linier()
Set sh1 = Sheets("MH") ' kilde ark - ret til aktuel
Set sh2 = Sheets("Til variant") ' destinations ark - ret til aktuel
For Each c In sh1.Range("AA1:AA78")
rk = sh2.Cells(65000, "A").End(xlUp).Row + 1
If c > 1 Then c.Copy sh2.Range("A" & rk)
Next
End Sub

Hej exelent

Nu virker formlen som ønsket, men jeg ønsker at det kun er værdien der bliver kopieret, ikke koden jeg får en -reference når jeg aktivere makroen.

Jeg skal brge noget i retning af:

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Men kan ikke gennemskue hvor jeg skal sætte det ind

så prøver vi igen :-)

Sub Linier()
Set sh1 = Sheets("MH") ' kilde ark - ret til aktuel
Set sh2 = Sheets("Til variant") ' destinations ark - ret til aktuel
For Each c In sh1.Range("AA1:AA78")
rk = sh2.Cells(65000, "A").End(xlUp).Row + 1
If c > 1 Then x = c: sh2.Range("A" & rk) = x
Next
End Sub

Hej Excelent
1000 tak for hjælpen, det virker perfekt

MVH
Ups