meerdere rijen invoegen in meerdere werkbladen

[sylvietoin]

Beste forumleden,

vraagje
ik heb een code gevonden voor het invoegen van één rij gelijktijdig in meerdere werkbladen op het zelfde rijnr.
hierbij wordt gevraagd na welkrijnr. deze rij ingevoegd moet worden
in deze nieuwe regel wordt vervolgens een bep. rijnr. (range met bep. inhoud en opbouw) gecopierd

werkt goed,
echter nu wil ik ipv. steeds 1 rij (met range van 1 rijnr.) bv. 2 of 3 rijen met range van 2 of 3 rijen invoegen
ik heb geprobeerd de code aan te passen, het invoegen gaat goed, alleen wordt dat steeds 1 of 2 rijen er onder overschreven wat niet de bedoeling is

is het mogelijk om bv. het aantal in te voegen rijen variabel te maken dmv. een invulbox zoals:
- na welk rijnr wilt u regel invoegen
en vervolgens
- hoeveel rijen wilt u invoegen

Sub insert_row()

Dim cs As String
Dim r As Range
Dim ws As Worksheet
Dim y As Integer
Application.ScreenUpdating = False
cs = ActiveSheet.Name

y = Application.InputBox("NA! welke rij nummer wilt u een rij invoegen, de overige rijen schuiven naar onder door", Type:=1) + 1
If y < 6 Then End
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "input" And ws.Name <> "Valideren" Then
ws.Activate
ActiveSheet.Unprotect Password:="10"
Range("a" & y).EntireRow.Insert
Range("a1").EntireRow.Copy Range("a" & y).EntireRow

ActiveSheet.Protect AllowInsertingRows:=True
ActiveSheet.Protect Password:="10"
End If
Next ws
Application.ScreenUpdating = True
Sheets("input").Select
Range("c" & y).Select
End Sub

------------------
2 rijen invoegen:

Sub insert_2_rows()

Dim cs As String
Dim r As Range
Dim ws As Worksheet
Dim y As Integer
Application.ScreenUpdating = False
cs = ActiveSheet.Name

y = Application.InputBox("NA! welke rij nummer wilt u 2 rijen invoegen, de overige rijen schuiven naar onder door", Type:=1) + 1
If y < 6 Then End
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Input" And ws.Name <> "Valideren" Then
ws.Activate
ActiveSheet.Unprotect Password:="10"
Range("a" & y).EntireRow.Insert
Range("a1:a2").EntireRow.Copy Range("a" & y).EntireRow

ActiveSheet.Protect AllowInsertingRows:=True
ActiveSheet.Protect Password:="10"
End If
Next ws
Application.ScreenUpdating = True
Sheets("Input").Select
Range("c" & y).Select
End Sub

hoor graag een oplossing
alvast bedankt

 

[puppie]

2keer dezelfde vraag.
daarom deze gesloten.
hier mag je verder gaan: http://www.helpmij.nl/forum/showthread.php/877081-meerdere-rijen-invoegen-in-meerdere-werkbladen