meerdere rijen invoegen

[sylvietoin]

beste forumleden

een soortgelijke vraag al eerder gesteld, echter op verkeerde plaats gepost, vandaar nogmaals

ik wil rijen in kunnen vullen onder een op te geven rijnr.:
deze werkt goed via onderstaande code

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

maar ik wil ook meerdere rijen in kunnen voegen
momenteel heb ik de code gemaakt voor 2 rijen

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

echter werkt niet goed
er wordt steeds slechts één regel ingevoegd en één overschreven
hoe kan ik dit oplossen?

eigenlijk wil ik via een knop, een variabel aantal rijen invoegen, onder een nader op te geven rijnr. via een invulbox
bv.
- na welk rijnr wilt u regel(s) invoegen
en vervolgens
- hoeveel rijen wilt u invoegen

hoor graag een oplossing
alvast bedankt

 

[VenA]

Loop eens met <F8> door de code en kijk welke waarde y krijgt

Range("a" & y).EntireRow.Insert zal maar één rij invoegen. Range("a" & y).resize(2).EntireRow.Insert zal twee rijen invoegen

 

[zapatr]

Precies VenA.
Ook als je de macrorecorder aanzet en de actie uitvoert, dan is er toch maar een kleine aanpassing nodig om het gewenste resultaat te krijgen. Zoiets zou de vragensteller zelf moeten kunnen met een beetje moeitje. De eerste macro van de vragensteller doet overigens niet wat hij beweert dat hij doet, hij heeft er kennelijk niet goed naar gekeken (maar natuurlijk is ook die macro eenvoudig aan te passen).

 

[sylvietoin]

Beste formuleden

bedankt voor jullie input
ik heb code iets aangepast, om dezeflde regel 2x in te voegen, werkt nu wel,maar omdat het een erg groot bestand is met veel voorwaardelijke opmaak wordt het commando ook 2x zo traag
(bij mij in volledige bestand nu ong. 30sec)
is de code niet aan te passen, zodat deze veel sneller werkt?

Sub insert_2row()
     
    Dim cs As String
    Dim r As Range
    Dim ws As Worksheet
    Dim y As Integer
    Dim i As Integer
Application.ScreenUpdating = False
    cs = ActiveSheet.Name
    
    y = Application.InputBox("NA! welke rij nummer wilt u een 2 rijen invoegen, de overige rijen schuiven naar onder door", Type:=1) + 1
        If y < 1 Then End
        i = y + 1
    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
            Range("a" & i).EntireRow.Insert
            Range("a1").EntireRow.Copy Range("a" & i).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

 

[zapatr]

- Wil je rijen kunnen invoegen in 1 blad of in meerdere bladen? (vraag omdat je naar namen van bladen kijkt).
- Moeten er beslist rijen gekopieerd worden, of is het voldoende dat er blanco rijen worden ingevoegd?

 

[VenA]

Haal de activate en select uit de code. Verder heb je mijn tip in #2 niet gebruikt waardoor je een dubbele handeling hebt. Probeer deze eens.

Sub insert_2row()
Application.ScreenUpdating = False
y = Application.InputBox("NA! welke rij nummer wilt u een 2 rijen invoegen, de overige rijen schuiven naar onder door", Type:=1) + 1
If y < 1 Then Exit Sub
For Each ws In Sheets
    If ws.Name <> "Input" And ws.Name <> "Valideren" Then
        With ws
            .Unprotect Password:="10"
            .Rows("1:1").Copy
            .Rows(y).Resize(2).Insert Shift:=xlDown
            .Protect "10", AllowInsertingRows:=True
        End With
    End If
Next ws
Application.Goto Sheets("Input").Range("c" & y)
End Sub