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

 

[edmoor]

Naast dat dit niets met Visual Basic .NET te maken heeft zou je de geplaatste code even in codetags moet zetten.
Zoals het er nu staat is het erg slecht te lezen.