Aantal rijen automatisch aanpassen

[surfingmaster]

In cel A2 heb ik het aantal rijen berekend dat moet komen te staan tussen rij 19 en de 5 na laatste rijen.

Nu wil ik dit via een macro oplossen, maar hij werkt niet.

Ik heb al wel een macro die het aantal kolommen aanpast, maar voor de rijen lukt mij het niet.

In cel A1 staat hoeveel kolommen in moeten worden gevoegd. De macro voor het aantal kolommen is:

Sub KolommenAanpassen()
Application.ScreenUpdating = False
With Sheets("Kosten uitg. in tijd")
    .Unprotect Password:=""
    For i = 1 To [A1] + 13 - .UsedRange.Columns.Count
        .Columns(14).Copy
        .Cells(1, .UsedRange.Columns.Count - 3).Insert
    Next
    .Protect Password:=""
End With
Application.ScreenUpdating = True
End Sub

Deze macro dacht ik aan te passen, zodat ik ook het aantal rijen kan bepalen.

Sub RijenAanpassen()
Application.ScreenUpdating = False
With Sheets("Kosten uitg. in tijd")
    .Unprotect Password:=""
    For i = 1 To [A2] + 20 - .UsedRange.Rows.Count
        .Rows(18).Copy
        .Cells(1, .UsedRange.Rows.Count - 5).Insert
    Next
    .Protect Password:=""
End With
Application.ScreenUpdating = True
End Sub

De laatste macro werkt niet kan iemand mij vertellen wat er niet aan klopt.

Alvast bedankt,
Erwin

 

[surfingmaster]

Beste Dames en heren.

Ik heb de macro zelf opgelost


Deze macro doet het volgende:
De macro telt eerst de bebruikte rijen van van 'Blad2'', daarna die van tabblad 'blad1'. Aan de hand hiervan berekend hij hoeveel regels er aan blad1 moeten worden toegegevoegd. De rijen die worden toegevoegd zijn een copie van regel 18.
Je kan dan de regels van 'Blad 2' kopieeren en meteen invoegen in 'Blad1'

Sub RijenAanpassen()
Application.ScreenUpdating = False
    Sheets("Blad1").Unprotect
    Sheets("Blad2").Unprotect
With Sheets("Blad2 ")
Dim Beg As Integer
 Beg = Sheets("Blad2").UsedRange.Rows.Count
End With
With Sheets("Blad1")
Dim Omz As Integer
 Omz = Sheets("Blad1").UsedRange.Rows.Count
End With
If Beg - (Omz - 28) > 0 Then
Rows("18:18").Copy
 With Sheets("Blad1")
Dim TEL As Integer
TEL = Sheets("Blad1").UsedRange.Rows.Count
Rows(TEL).Offset(-9, 0).Select
Dim rng
rng = Beg - (Omz - 28)
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(rng - 1, 0)).Insert
Selection.EntireRow.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Blad1").Protect
Sheets("Blad2").Protect
Application.ScreenUpdating = True
End With
Else
Sheets("Blad1").Protect
Sheets("Blad2").Protect
Application.ScreenUpdating = True
End If
End Sub

Met vriendelijke groet,
Erwin