VBA code om rijen in te voegen

[GREAT2024]

Goedemiddag,

Ik ben nieuw hier en hoop dat iemand mij kan helpen.

Ik heb een heel groot Excel-bestand, waarbij ik op verschillende kolommen filter.
Boven de rijen die op dat moment gefilterd zijn wil ik d.m.v. een macro een X-aantal (d.m.v. invulveld, omdat het de ene keer 4 en andere keer 8 zijn) rijen erboven invoegen.
Is dit mogelijk? Zo ja, heeft iemand de VBA code voor mij?

Alvast bedankt.

groet, Maikel

P.S. een aantal weken geleden had ik de code volgens mij gevonden op dit forum, maar kan deze niet meer vinden.

 

[AHulpje]

Zoiets, zelf nog even foutcontroles toevoegen:

Sub Invoegen()
    n = InputBox("Hoeveel rijen wilt u inmvoegen?", "Invoegen rijen")
    rij = ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Row
    Rows(rij & ":" & rij + n - 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End Sub

 

[JEC.]

Probeer dit eens

Sub jec()
 Dim x, a As Long, j As Long, jj As Long
 Application.ScreenUpdating = False
 With Range("A2", Range("D" & Rows.Count).End(xlUp))
   a = Application.InputBox("Hoeveel rijen invoegen?", , , , , , , 1)
   If a = False Or .Parent.FilterMode = False Then Exit Sub
   Set x = .Columns(1).SpecialCells(12)
   For j = x.Count To 1 Step -1
     For jj = 1 To a
        x(j).EntireRow.Insert
     Next
   Next
  .AutoFilter
 End With
End Sub

 

[snb]

Sub M_snb()
  On Error Resume Next
  Rows(1).Resize(InputBox("aantal",,4)).Insert
End Sub

 

[JEC.]

Zie even niet hoe dit aansluit op de vraag

 

[AHulpje]

Uitgaande van het gefilterde werkblad:
Sub jec() voegt het opgegeven aantal rijen helemaal bovenaan toe.
Sub M_snb() voegt één rij helemaal bovenaan toe.

Doe ik iets fout?

 

[JEC.]

De with regel had je nog verwezen naar kolom D
Pas deze eens aan naar alleen

With Range("A2", Range("A" & Rows.Count).End(xlUp))

 

[AHulpje]

@jec
Had jouw "D" inderdaad over het hoofd gezien.
Maar met "D" => "A" voegt hij boven iedere niet gefilterde rij het opgegeven aantal rijen in.

 

[JEC.]

Een andere methode

Sub jec()
 Dim ar, a As Long, j As Long, jj As Long
 Application.ScreenUpdating = False
 
 Set ar = Range("A2", Range("A" & Rows.Count).End(xlUp))
 a = Application.InputBox("Hoeveel rijen invoegen?", , , , , , , 1)
 If a = False Or ar.Parent.FilterMode = False Then Exit Sub
    
 For j = ar.Rows.Count To 1 Step -1
   If ar(j).RowHeight Then
     For jj = 1 To a
        Rows(j + 1).Insert
     Next
   End If
 Next

 ar.AutoFilter
End Sub