Macro Excel rijen invoegen onder + deel van bovenliggende formules

[Vansteenkiste]

Hallo,

Ik werk een tabel uit waarin uitgevoerde taken kunnen worden aangeduid per patiënt en per dag. patiëntgegevens worden overgenomen uit ander tabblad.
Gebruiker dient voor iedere patiënt willekeurig aantal rijen extra in te voegen, soms geen, soms meerdere.
Bovendien moeten de formules van bereik J tot BG automatisch mee gekopiëerd worden en deze van bereik A tot I niet.
Ik heb al een macro gemaakt maar deze voegt 5 rijen boven in in plaats van onder. Formules worden nog niet meegekopiëerd.
Zie afbeelding en bijgevoegd sterk vereenvoudigd bestand (100 kb).




Ik zou graag twee macro's gebruiken, een voor invoegen twee rijen + kopiëren deel formules en een voor invoegen 4 rijen + kopiëren deel formules.
Zou ook handig zijn de datum in kolom N die wordt overgenomen uit andere tabel in volgende rijen wordt meegekopieerd, telkens +1.
Kan iemand mij op de goede weg zetten?


Vriendelijke groeten,

Luc Vansteenkiste

 

[snb]

Dag Luc,

Welkom in dit forum.

Het is gewenst in een Excelforum Excel-voorbeeldbestanden mee te sturen in plaats van plaatjes (Excel is nu eenmaal geen beeldbewerkingsprogramma).

 

[VenA]

Het kan aan mij liggen maar ik ik zie het toegevoegde bestand niet. Als het bestand te groot is dan kan je het het bestand eerst opslaan als .xlsb en vervolgens hier plaatsen.

 

[Vansteenkiste]

Nieuwe poging om bestand te uploaden

Dag,

ik probeer nog eens up te loaden als .xlsb bestand.

In voorbeeld is met macro1 rij 16 (nr 382) gekopieerd naar rij 17 waarbij de cellen tot en met kolom Z zijn verwijderd uitgezonderd kolom N en O.
De formules van AA tot AF worden doorgevoerd.
Dit is wat ik wil als resultaat voor één lijn. Zou wel handig zijn dat datum in kolom N bij invoegen rij telkens verhoogt met 1 (19 >20>21)

Einddoel is: 2 macro's met sneltoetsen, een voor invoegen 2 rijen en een voor invoegen 4 rijen.
Macro die ik heb geschreven kan zeker eenvoudiger en sneller werken. Hoe aanpassen?
Bekijk bijlage 2016-09-09 Taakopvolging - voorbeeld 2 -.xlsb


Ondertussen zelf volgende macro aangemaakt:

Sub Rijeninvoegenonder()
'Voegt onder de actieve cel een rij in
'en kopieert de formules van die actieve cell
'naar die ingevoegde rij
ActiveSheet.Unprotect
ActiveCell.Offset(1, 0).EntireRow.Insert
Rows(ActiveCell.Offset(1, 0).Row).FillDown
ActiveCell.Offset(1, 0).ClearContents
ActiveCell.Offset(1, 1).ClearContents
ActiveCell.Offset(1, 2).ClearContents
ActiveCell.Offset(1, 3).ClearContents
ActiveCell.Offset(1, 4).ClearContents
ActiveCell.Offset(1, 5).ClearContents
ActiveCell.Offset(1, 6).ClearContents
ActiveCell.Offset(1, 7).ClearContents
ActiveCell.Offset(1, 8).ClearContents
ActiveCell.Offset(1, 9).ClearContents
ActiveCell.Offset(1, 10).ClearContents
ActiveCell.Offset(1, 11).ClearContents
ActiveCell.Offset(1, 12).ClearContents
ActiveCell.Offset(1, 15).ClearContents
ActiveCell.Offset(1, 16).ClearContents
ActiveCell.Offset(1, 17).ClearContents
ActiveCell.Offset(1, 18).ClearContents
ActiveCell.Offset(1, 19).ClearContents
ActiveCell.Offset(1, 20).ClearContents
ActiveCell.Offset(1, 21).ClearContents
ActiveCell.Offset(1, 22).ClearContents
ActiveCell.Offset(1, 23).ClearContents
ActiveCell.Offset(1, 24).ClearContents
ActiveCell.Offset(1, 25).ClearContents
ActiveCell.Offset(1, 26).ClearContents
ActiveCell.Offset(1, 27).ClearContents
ActiveCell.Offset(1, 28).ClearContents
ActiveCell.Offset(1, 29).ClearContents
ActiveCell.Offset(1, 30).ClearContents
ActiveCell.Offset(1, 31).ClearContents
ActiveCell.Offset(1, 32).ClearContents
ActiveCell.Offset(1, 33).ClearContents
ActiveCell.Offset(1, 34).ClearContents
ActiveCell.Offset(1, 35).ClearContents
ActiveCell.Offset(1, 0).EntireRow.Insert
Rows(ActiveCell.Offset(1, 0).Row).FillDown
ActiveCell.Offset(1, 0).ClearContents
ActiveCell.Offset(1, 1).ClearContents
ActiveCell.Offset(1, 2).ClearContents
ActiveCell.Offset(1, 3).ClearContents
ActiveCell.Offset(1, 4).ClearContents
ActiveCell.Offset(1, 5).ClearContents
ActiveCell.Offset(1, 6).ClearContents
ActiveCell.Offset(1, 7).ClearContents
ActiveCell.Offset(1, 8).ClearContents
ActiveCell.Offset(1, 9).ClearContents
ActiveCell.Offset(1, 10).ClearContents
ActiveCell.Offset(1, 11).ClearContents
ActiveCell.Offset(1, 12).ClearContents
ActiveCell.Offset(1, 15).ClearContents
ActiveCell.Offset(1, 16).ClearContents
ActiveCell.Offset(1, 17).ClearContents
ActiveCell.Offset(1, 18).ClearContents
ActiveCell.Offset(1, 19).ClearContents
ActiveCell.Offset(1, 20).ClearContents
ActiveCell.Offset(1, 21).ClearContents
ActiveCell.Offset(1, 22).ClearContents
ActiveCell.Offset(1, 23).ClearContents
ActiveCell.Offset(1, 24).ClearContents
ActiveCell.Offset(1, 25).ClearContents
ActiveCell.Offset(1, 26).ClearContents
ActiveCell.Offset(1, 27).ClearContents
ActiveCell.Offset(1, 28).ClearContents
ActiveCell.Offset(1, 29).ClearContents
ActiveCell.Offset(1, 30).ClearContents
ActiveCell.Offset(1, 31).ClearContents
ActiveCell.Offset(1, 32).ClearContents
ActiveCell.Offset(1, 33).ClearContents
ActiveCell.Offset(1, 34).ClearContents
ActiveCell.Offset(1, 35).ClearContents
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowInsertingRows:=True, AllowSorting:=True, AllowFiltering:=True
End Sub

Doet wat het moet doen maar code moet veel korter kunnen.

Wie helpt mij?

 

[Vansteenkiste]

Oplossing zelf gevonden

Ik heb de oplossing zelf gevonden.