Rij toevoegen o.b.v. laatste (variabele) rij met behoud formules

[jpsande]

Beste mensen,

Na enig speurwerk en codes van andere topics, dit alles zonder succes, hoop ik dat iemand mij hier verder kan helpen.

Ik zoek een Macro code waarmee een variabel aantal rijen kan worden toegevoegd (middels een input box) onderaan een tabel, waarbij formules en opmaak mee worden genomen.

Inmiddels ben ik tot de volgende code gekomen:

Sub Invoegen_Click()
Regel = InputBox("Hoeveel regels wil je erbij?")
On Error GoTo Fout
For i = 1 To Regel
  rij = Range("A2015").EntireRow.Select
  Selection.Copy
  Selection.Insert Shift:=xlDown
  Application.CutCopyMode = False
  ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
  Application.ScreenUpdating = True
Next i
Fout:
End Sub

Deze code werkt zoals deze zou moeten (opmaak en formule's worden meegenomen) met 1 uitzondering; de regel welke gekopieerd wordt is nummer 2015 en vervolgens worden de nieuwe regels daaronder geplakt. Echter als regel reeds 2015 is gebruikt dan worden de gegevens in deze regel meegenomen in de nieuwe regel, wat niet de bedoeling is. Ook wordt de nieuwe regel tussen 2015 en 2016 ingevoegd, wat niet de bedoeling is als je bijvoorbeeld al bij regel 2020 bent.

Ik zoek dus een aanpassing in de code, zodat de laatste, ongebruikte regel als "te kopiëren" regel wordt gebruikt, en onderaan de tabel wordt geplakt.

Dus regel 2015, welke leeg is, wordt 3x gekopieerd en geplakt. Bij de volgende keer het gebruiken van de macro wordt regel 2018 gekopieerd en geplakt etc.

Wie kan mij helpen?

 

[geep1980]

probeer het eens met 1 van de twee volgende regels

LastRow = Application.CountIf(Worksheets("Total Input").Range("A:A"), ">""")
Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)

 

[ExcelAmateur]

jpsande,

Zo kreeg ik hem aan de praat.
Hij maak van de laatst gevulde regel een kopie en voegt,
de regels aan de onderkant toe (is dat de bedoeling?)

Sub Invoegen_Click()
  Regel = InputBox("Hoeveel regels wil je erbij?")
  ActiveSheet.Unprotect
On Error GoTo Fout
For i = 1 To Regel
  rij = Cells(Rows.Count, "A").End(xlUp).Offset(0, 0).EntireRow.Copy
  Selection.Insert Shift:=xlDown
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
Next i
  ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
Fout:
End Sub