Specifieke selectie in macro verwijderen

[MGM]

De volgende macro heb ik voor handen:
Het doel is om in de regel waar de cel in staat om er onder een kopie van die regel te maken. Wanneer er in kolom een 'X' staat, dan mag de regel niet verwijdert worden. Wanneer er een 'Y' staat is de opdracht dat er een kopie wordt gemaakt. Zodra er een kopie wordt gemaakt is het de bedoeling dat alle tekst in kolom C t/m H eruit wordt gehaald. Hier zit voor mij nu even de uitdaging. Weet iemand vanaf het dik gedrukte deel de formule zo geschreven moet worden? Als ik dit nl. 'opneem' via de macrowizard, dan is dit direct gekoppeld aan een specifiek rijnummer, en dat is nu net niet de bedoeling, omdat de formule moet kijken naar waar de cel is geselecteerd.

Ik hoor graag.

Alvast bedankt.


Sub regel_invoegen()
' Hiermee voegt u een regel in bij bij het overzicht aanvullende wensen.

If Cells(ActiveCell.Row, 1) = "X" Then
Exit Sub

Else
' BEVEILIGING OPHEFFEN
ActiveSheet.Unprotect ""
' SELECTEREN EN KOPIËREN
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Copy
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown
Range ("C:H")
Selection.ClearContents
Application.CutCopyMode = False
' DE GEWENSTE CEL SELECTEREN
ActiveCell.Offset(0, 2).Range("A1").Select
' BLAD BEVEILIGEN
ActiveSheet.Protect "", AllowFiltering:=True
End If
End Sub

 

[snb]

In de afgelopen 13 jaar is niets gewijzigd aan de eis om VBA code tussen code tags te zetten.
Al die jaren is het ook gebruikelijk een voorbeeldbestand te plaatsen bij dit soort vragen.

 

[MGM]

De macro tussen de codetags was mij (nog) niet bekend. In het testbestand 2.0 is nu een werkende macro voor het invoegen van een nieuwe regel, alleen wanneer er een 'Y' in kolom A staat. Wanneer er een X staat, gebeurt er niks. Mijn vraag is of er een mogelijkheid is om kolom B (het streepje) en kolom E (de dubbelepunt) te behouden.

Het document is beveiligd zonder wachtwoord.

Sub meerminderwerk_regel_invoegen()
' Hiermee voegt u een regel in bij het meer- minderwerkoverzicht.

If Cells(ActiveCell.Row, 1) = "X" Then
Exit Sub

Else
'   SELECTEREN EN KOPIËREN
    ActiveCell.Rows("1:1").EntireRow.Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
    Selection.Insert Shift:=xlDown
[B]    Selection.ClearContents
    Range ("C:H")[/B]
    Application.CutCopyMode = False
'   DE GEWENSTE CEL SELECTEREN
    ActiveCell.Offset(0, 2).Range("A1").Select
End If
End Sub