Lege regel invoegen

[Gripmaster]

Zoals de titel al aangeeft.
In het bijgevoegde bestand is het volgende toegevoegd.
Een planning waar ik eerst een keuze kan maken tussen disciplines en vervolgens wie bij welke discipline hoort.

Nu wil ik doormiddel van bovenstaande knop "nieuw project invoegen', een nieuwe totaal regel invoegen waar geen gegevens in staan en die samengevoegd is over de groene kolommen.
Hier dient een naam van het werk te komen staan. Deze moet handmatig ingevuld worden.

Ik zie graag iets verschijnen

 

[exhelp]

Wat bedoel je met een nieuwe regel invoegen?
Een lijn toevoegen onderaan, dus op regel 169?

 

[Gripmaster]

Excusses,

Nee willekeurig. Ik dien bijvoorbeeld 5 personen in te vullen. Hieronder wil ik na 1 regel overgeslagen te hebben een nieuwe project toevoegen, waarna ik weer 6 personen nodig heb. enzo enzo.
Het moet een overzicht zijnwaarbij ik inzichtelijk krijg welke personen bij welk project zjin ingepland en dit wijzigbaar blijft.

 

[exhelp]

Sorry Gripmaster,

Ik begrijp niet wat je wil bereiken.
Kan je eventueel je voorbeeldbestand vullen met hoe het er zou kunnen uitzien als het zou werken?

 

[Gripmaster]

Bij deze en dan wil ik de dikgedrukte werken willekeurig ergens kunnen neerzetten.

 

[exhelp]

Zit dit in de goede richting?

Sub nieuw_project()
Dim newrow

newrow = Cells(Rows.Count, "A").End(xlUp).Row + 2

With ActiveWorkbook.Sheets(1).Rows(newrow)

    .Select
    Selection.Insert Shift:=xlDown
  
End With

newrow = Cells(Rows.Count, "A").End(xlUp).Row + 2

With ActiveWorkbook.Sheets(1).Range("A" & newrow & ":B" & newrow)
    
    .HorizontalAlignment = xlLeft
    .MergeCells = True
    .Font.Bold = True

End With

End Sub

 

[Gripmaster]

Dit is perfect, maar wanneer ik heb invoeg dan staat nog steeds gegevensvalidatie erin.
Ik kan er dus niet intypen.

 

[exhelp]

Zo zou het moeten lukken:

Sub nieuw_project()
Dim newrow

newrow = Cells(Rows.Count, "A").End(xlUp).Row + 2

With ActiveWorkbook.Sheets(1).Rows(newrow)

    .Select
    Selection.Insert Shift:=xlDown
  
End With

With ActiveWorkbook.Sheets(1).Range("A" & newrow + 1 & ":B" & newrow + 1)
    
    .HorizontalAlignment = xlLeft
    .MergeCells = True
    .Font.Bold = True
    .ClearCircles

End With

End Sub

 

[Gripmaster]

Thx Dit is perfect. Topic kan worden gesloten

 

[exhelp]

:thumb: