nw regel met behoud eigenschappen vorige regel en dan waarde erin verwijderen behalve

[Ropw]

Wie helpt me?
Onderstaand VBA creëert een nieuwe regel met behoud eigenschappen vorige regel en dan worden de waarden in de nieuwe regel verwijderd.
Dat gaat goed, alleen in die nieuwe regel moeten in de laatste 2 kolommen de waarde juist wel bewaard blijven. Dus in kolom AV en AW.
Hoe aan te passen?

Sub NieuweBoxregel()
'
' NieuweBoxregel Macro
' nieuwe regel met eigenschappen
'
' Sneltoets: Ctrl+Shift+N
'
Sheets("containers").Select
ActiveSheet.Unprotect
lrow = Selection.Row()
Rows(lrow).Select
Selection.Copy
Rows(lrow + 1).Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
Selection.ClearContents
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True


End Sub

 

[VenA]

je kan hier eens kijken http://www.helpmij.nl/forum/showthread.php/870315-Handleiding-Code-tags-gebruiken-Manual-Code-tags-usage?p=5595087#post5595087

 

[E v R]

Die waarde in kolom AV en AW, wat voor waarde is dit? Lijkt er namelijk op dat je de standaard functionaliteit van een Tabel aan het nabouwen bent

 

[edmoor]

En zonder verder iets aan je code te wijzigen:

Sub NieuweBoxregel()
    '
    ' NieuweBoxregel Macro
    ' nieuwe regel met eigenschappen
    '
    ' Sneltoets: Ctrl+Shift+N
    '
    Sheets("containers").Select
    ActiveSheet.Unprotect
    lrow = Selection.Row()
    Rows(lrow).Select
    Selection.Copy
    Rows(lrow + 1).Select
    Selection.Insert Shift:=xlDown
    Application.CutCopyMode = False
    Selection.ClearContents
    Cells(lrow + 1, "AV") = Cells(lrow, "AV").Value
    Cells(lrow + 1, "AW") = Cells(lrow, "AW").Value
    ActiveCell.Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

 

[Ropw]

werkt als een tierelier. hartelijk dank

 

[Ropw]

sorry ik was te snel, het werkt nog niet. In de cel AV en AW staat een formule. Die wordt toch schoongespoeld door Selection.ClearContens.

 

[VenA]

Zonder select en selection

With ActiveCell
    .EntireRow.Copy
    .Offset(1).EntireRow.Insert
    Rows(.Row + 1).SpecialCells(2).ClearContents
  End With

 

[Ropw]

voor VenA
het lukt me niet om die code te markeren. Als ik na selectie op # druk verdwijnt de gehele code

 

[gast0660]

Sub NieuweBoxregel()
With Sheets("containers")
lrow = Selection.Row()
.Unprotect
.Rows(lrow).Copy
.Rows(lrow + 1).Insert Shift:=xlDown
.Rows(lrow + 1).Columns("A:AU").ClearContents
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
Application.CutCopyMode = False
End Sub

 

[Ropw]

Briljant en bedankt weer VenA. Dit werkt uitstekend.

 

[edmoor]

voor VenA
het lukt me niet om die code te markeren. Als ik na selectie op # druk verdwijnt de gehele code

Druk eerst op die knop en plak dan je code.

 

[E v R]

Fijn dat het werkt, met formules in AV en AW gaat mijn reaktie uit post#3 volledig op, Tip: kijk er eens naar