Overførelse

Sub Overfør()
Set sh1 = Sheets("Ark1")
Set sh2 = Sheets("Ark2")
rk = sh2.Cells(1000, "A").End(xlUp).Row + 1
'kopier celle A4 og B4 til kolonne A og B i Ark2
sh2.Cells(rk, "A") = sh1.Cells(4, "A")
sh2.Cells(rk, "B") = sh1.Cells(4, "B")
'slet indtastning i Ark1
sh1.Range("A1:B3") = ""
End Sub

super godt, men jeg vil gerne have at det at jeg skriver i sheet1- A4 og B4 overføres til sheet2- A4 og B4 og sheet1 A5 og B5 til sheet2 A5 og B5.
Kan dette lade sig gøre?

jada :-)

Sub Overfør()
startrække = 4 ' data starter i række 4 på Ark2 ret evt. til andet
Set sh1 = Sheets("Ark1")
Set sh2 = Sheets("Ark2")
rk = sh2.Cells(1000, "A").End(xlUp).Row + 1
If rk < startrække Then rk = startrække
'kopier celle A4:B5 til kolonne A og B i Ark2
sh2.Cells(rk, "A") = sh1.Cells(4, "A")
sh2.Cells(rk, "B") = sh1.Cells(4, "B")
sh2.Cells(rk + 1, "A") = sh1.Cells(5, "A")
sh2.Cells(rk + 1, "B") = sh1.Cells(5, "B")
'slet indtastning i Ark1
sh1.Range("A4:B5") = ""
End Sub