Flere linjer?

Prøv lige på en kopi først (forudsætter data i kolonne A:D)

Sub IndsætRK()

Set sh = Sheets("Ark1")
rk = sh.Cells(65500, 1).End(xlUp).Row

For t = rk To 1 Step -1
If Cells(t, 2) = "Y" Then
Rows(t + 1).EntireRow.Insert
Cells(t, 1).Copy Cells(t + 1, 1)
Cells(t, 2).Copy Cells(t + 1, 2)
Cells(t, 4).Cut Cells(t + 1, 3)
End If
Next

End Sub

Virker desværre ikke. Får en compile error: variable not defined.

så dimmer vi lige variablerne

Sub IndsætRK()
dim sh,rk,t
Set sh = Sheets("Ark1")
rk = sh.Cells(65500, 1).End(xlUp).Row

For t = rk To 1 Step -1
If Cells(t, 2) = "Y" Then
Rows(t + 1).EntireRow.Insert
Cells(t, 1).Copy Cells(t + 1, 1)
Cells(t, 2).Copy Cells(t + 1, 2)
Cells(t, 4).Cut Cells(t + 1, 3)
End If
Next

End Sub

Nu fejler den ikke, men til gengæld sker der ikke en pind... Er det muligt, at få et eventuelt resultat smidt over i ark2 ?

ja det er ikke noget problem, men da koden ikke virker,
må du hellere fortælle hvor dine data er nu

mine data ligger som de gør oprindeligt - i ark1
Det skal dog nævnes, at der er mere end de 4 kolonner i det viste eksempel (nærmere 20).

Havde tænkt mig at kopiere de 4 kolonner til ark2 og så
indsætte de ekstra rækker der, så hvilke 4 kolonner er det?

Der er vel ikke tomme mellemrum før eller efter "Y"?

Prøv med: If UCase(Trim(Cells(t, 2))) = "Y" Then

Der er ingen tomme mellemrum før eller efter "Y".

Det er jo forskellige kolonner alt efter om det er den "oprindelige række" eller den nye række. Hvis det er den oprindelige skal den kopiere kolonne 20 til 29, og den nye række skal indeholde kolonne 31 til 39.

Forvirringen breder sig
kolonner er de lodrette søjlerne A,B,C,D osv
rækker er de vandrette linier 1,2,3,4,5 osv

Jeg aner trods flere indlæg stadig ikke hvor kolonnen med Y'er er
eller hvor mange kolonner der skal kopieres med over i ark2.

Går dog stadig ud fra det er kolonne med Y'er samt kolonnen
til venstre herfor, samt de 2 kolonner tilhøjre herfor koden
skal bearbejde ?

Jeg har ikke være god nok til at formulere mig, undskyld. :)
Kolonnen med Y'er er kolonne K (nr. 11) og de kolonner, der skal kopieres er hhv. fra T til AC og AE til AM. Har du en mailadresse jeg eventuelt kan sende dig filen?
1000 tak fordi du gider hjælpe!

ja det er nok lettere at se når jeg har filen
send til pm@madsen.tdcadsl.dk

Sendt :)

ok prøv denne :

Sub IndsætRK()
Dim sh1, sh2, rk1, t
Set sh1 = Sheets("Oprettelse")
Set sh2 = Sheets("Ark2") ' ret evt til aktuel arknavn

rk1 = sh1.Cells(65500, "T").End(xlUp).Row

sh1.Range("T1:AC1").Copy sh2.Range("A1")

For t = 2 To rk1

sh1.Range("T" & t & ":AC" & t).Copy
sh2.Cells(sh2.Cells(65500, 1).End(xlUp).Row + 1, "A").Select
Selection.PasteSpecial Paste:=xlPasteValues

If InStr(1, sh1.Cells(t, "K"), "Y") <> 0 Then
sh1.Cells(t, "T").Copy
sh2.Cells(sh2.Cells(65500, 1).End(xlUp).Row + 1, "A").Select
Selection.PasteSpecial Paste:=xlPasteValues
sh1.Range("AE" & t & ":AM" & t).Copy
sh2.Cells(sh2.Cells(65500, 2).End(xlUp).Row + 1, "B").Select
Selection.PasteSpecial Paste:=xlPasteValues
End If

Next
Application.CutCopyMode = False
Cells(1, 1).Select
End Sub

ok velbekom