Macro die rij toevoegt ook laten werken in beveiligde omgeving.

Status
Niet open voor verdere reacties.
D

dragonbeat

Nieuwe gebruiker
Lid geworden
23 nov 2022
Berichten
2
Hoi,

Ik heb een macro die in de basis werkt, maar niet meer werkt als ik de sheet beveilig. Ik heb twee problemen.

In mijn eerste dertien rijen staan formules die niet gewijzigd mogen worden. Alles vanaf rij 14 mag men wijzigen zonder problemen.
Mijn macro is er 1 die automatisch de formules meekopieert van de rij erboven. Dit is handig voor rij 14 en verder, maar desastreus als je met je cursor op de eerste 13 rijen staat.
Dan staat er foutieve data.
Ik heb zelf al een macro gevonden waarmee ik automatisch een rij kan toevoegen. Deze macro moet alleen niet werken als ik met mijn cursor in de eerste 13 rijen sta.
En wel werken in de beveiligde omgeving.
Mijn macro werkt alleen nu helemaal niet als ik de sheet beveilig.
Ik reeds het bereik wat bewerken toelaat aangezet vanaf rij 14 maar dit lost mijn probleem nog niet op.

Wie snapt mij en kan onderstaande codering aanpassen? De selectie heeft nu nog geen uitzondering voor rij 14 in de code en daarnaast is de macro uitgeschakeld als de sheet wordt beveiligd. Beiden wil ik niet :p

Sub NieuweRijInvoegen()


If ActiveSheet.ProtectContents Then


MsgBox "Het werkblad is beschermd!"


Else


With ActiveCell
.EntireRow.Select
.EntireRow.Insert
.EntireRow.Copy
End With


With Selection
.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.Cells(1, 3).Select
End With


Application.CutCopyMode = False


End If


End Sub
 
Zoiets:

Code: 
Sub NieuweRijInvoegen()
    If ActiveCell.Row < 14 Then Exit Sub
    ActiveSheet.Unprotect "jouwpassword"
    With ActiveCell
        .EntireRow.Select
        .EntireRow.Insert
        .EntireRow.Copy
    End With
    With Selection
        .PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        .Cells(1, 3).Select
    End With
    Application.CutCopyMode = False
    ActiveSheet.Protect "jouwpassword"
End Sub
 
Laatst bewerkt:
Wat een baas ben jij. Mega snel gereageerd en het werkt. Ik ben je super dankbaar! :D
Top forum dit!
 
Of:
Code: 
Sub hsv()
 With ActiveCell.EntireRow
   .Copy
   .Insert xlAbove
 End With
Application.CutCopyMode = False
End Sub

Met enig verschil in de formules mits rij relatief.
Code: 
Sub hsv_2()
With ActiveCell.EntireRow
  .Insert
  .Offset(-1).Formula = .Formula
End With
End Sub
 
Gebruik een dynamische tabel, die doet zelf wat jij probeert te programmeren.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan