Veranderingen op meerdere bladen weergeven.

[Antonius100]

Goedemorgen allen,

ik had een vraag om veranderingen van een totaalblad ook naar een detailblad te kopieeren.
Wat ik bedoel is dit;
Onderstaand staat een macro wat er voor zorgt dat, wanneer ik op de rechtermuisknop klik, de keuze krijg om een cel tussen al gevulde cellen in te voegen die zowel op het detail als totaalblad tevoor schijn komt
Ik heb een totaalblad, en een aantal detailbladen. Echter wil ik dat veranderingen meeveranderen als ik iets wijzig op het totaalblad of detailblad en andersom.
Het totaalblad is eigenlijk een samenvatting van een 15tal detailbladen.
Echter wil ik nu een macro maken die er voor zorgt dat via een rechtermuisklik in de plaats van invoegen nu de cel kopieert ( met opmaak ) en dan met de rechtermuisklik ook weer kan plakken tussen een cel waar ik voor kies.
Hopelijk snappen jullie wat ik bedoel, zoniet probeer ik het wat beter uit te leggen.

Met vriendelijke groet,

Teun

Option Explicit
Const TotaalSheet As String = "totaal overzicht"
Const AfdelingRij As Integer = 1

Sub RegelToevoegen()
  Dim HuidigeSheet As String, Rij As Long

  Application.ScreenUpdating = False

  HuidigeSheet = ActiveSheet.Name
  Rij = ActiveCell.Row

  If LCase(HuidigeSheet) = TotaalSheet Then
    Dim Kolomstart As Integer, SheetNaam As String

    Kolomstart = (Int((ActiveCell.Column - 1) / 3) * 3 + 1)
    SheetNaam = Cells(AfdelingRij, Kolomstart).Value

    If SheetExists(SheetNaam) Then 'totaalsheet
      Range(Cells(Rij, Kolomstart), Cells(Rij, Kolomstart + 2)).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
      Range(Cells(Rij, Kolomstart), Cells(Rij, Kolomstart + 2)).Interior.ColorIndex = xlNone
      
      Sheets(SheetNaam).Select
      Range(Cells(Rij, "A"), Cells(Rij, "C")).Insert Shift:=xlShiftDown, CopyOrigin:=xlFormatFromLeftOrAbove
      Range(Cells(Rij, "A"), Cells(Rij, "C")).Interior.ColorIndex = xlNone
    Else
      MsgBox "Sheet: " & SheetNaam & " is niet in dit workbook aanwezig" & Chr(10) & _
             "regel toevoegen niet uitgevoerd", vbCritical, "Fout gededecteerd"
    End If
  Else  'Sub sheets
    If SheetExists(TotaalSheet) Then
      Dim Kolom As Range
      
      Range(Cells(Rij, "A"), Cells(Rij, "C")).Insert Shift:=xlShiftDown, CopyOrigin:=xlFormatFromLeftOrAbove
      Range(Cells(Rij, "A"), Cells(Rij, "C")).Interior.ColorIndex = xlNone

      Sheets(TotaalSheet).Select
      Set Kolom = Rows(AfdelingRij).Find(HuidigeSheet, LookIn:=xlValues)
      If Kolom Is Nothing Then
        MsgBox "Sheet: " & HuidigeSheet & " staat niet in sheet: " & TotaalSheet, vbCritical, "Fout gededecteerd"
      Else
        Range(Cells(Rij, Kolom.Column), Cells(Rij, Kolom.Column + 2)).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Range(Cells(Rij, Kolom.Column), Cells(Rij, Kolom.Column + 2)).Interior.ColorIndex = xlNone
      End If
    Else
      MsgBox "Sheet: " & TotaalSheet & " is niet in dit workbook aanwezig" & Chr(10) & _
             "regel toevoegen niet uitgevoerd", vbCritical, "Fout gededecteerd"
    End If
  End If

  Sheets(HuidigeSheet).Select
  Application.ScreenUpdating = True
End Sub

Sub RegelVerwijderen()
  Dim HuidigeSheet As String, Rij As Long

  Application.ScreenUpdating = False

  HuidigeSheet = ActiveSheet.Name
  Rij = ActiveCell.Row

  If LCase(HuidigeSheet) = TotaalSheet Then
    Dim Kolomstart As Integer, SheetNaam As String

    Kolomstart = (Int((ActiveCell.Column - 1) / 3) * 3 + 1)
    SheetNaam = Cells(AfdelingRij, Kolomstart).Value

    If SheetExists(SheetNaam) Then 'totaalsheet
      Range(Cells(Rij, Kolomstart), Cells(Rij, Kolomstart + 2)).Delete Shift:=xlUp
      
      Sheets(SheetNaam).Select
      Range(Cells(Rij, "A"), Cells(Rij, "C")).Delete Shift:=xlUp
    Else
      MsgBox "Sheet: " & SheetNaam & " is niet in dit workbook aanwezig" & Chr(10) & _
             "regel Verwijderen niet uitgevoerd", vbCritical, "Fout gededecteerd"
    End If
  Else  'Sub sheets
    If SheetExists(TotaalSheet) Then
      Dim Kolom As Range
      
      Range(Cells(Rij, "A"), Cells(Rij, "C")).Delete Shift:=xlUp

      Sheets(TotaalSheet).Select
      Set Kolom = Rows(AfdelingRij).Find(HuidigeSheet, LookIn:=xlValues)
      If Kolom Is Nothing Then
        MsgBox "Sheet: " & HuidigeSheet & " staat niet in sheet: " & TotaalSheet, vbCritical, "Fout gededecteerd"
      Else
        Range(Cells(Rij, Kolom.Column), Cells(Rij, Kolom.Column + 2)).Delete Shift:=xlUp
      End If
    Else
      MsgBox "Sheet: " & TotaalSheet & " is niet in dit workbook aanwezig" & Chr(10) & _
             "regel verwijderen niet uitgevoerd", vbCritical, "Fout gededecteerd"
    End If
  End If

  Sheets(HuidigeSheet).Select
  Application.ScreenUpdating = True
End Sub

Private Function SheetExists(Sheetname As String) As Boolean
  On Error Resume Next
  Dim x As Object
  
  SheetExists = False
  Set x = ActiveWorkbook.Sheets(Sheetname)
  If Err = 0 Then SheetExists = True
End Function

En

Option Explicit
Const Tagnaam As String = "Regel toevoegen"
Const Captionnaam1 As String = "Machine toevoegen"
Const Aktie1 As String = "RegelToevoegen"
Const Captionnaam2 As String = "Machine Verwijderen"
Const Aktie2 As String = "RegelVerwijderen"

Sub MenuToevoegen()
  If Not Application.CommandBars("Cell").FindControl(Tag:=Tagnaam) Is Nothing Then Exit Sub
  With Application.CommandBars("cell").Controls
    With .Add(Type:=msoControlButton, Before:=1, temporary:=True)
      .Caption = Captionnaam2
      .OnAction = Aktie2
      .Tag = Tagnaam
      .FaceId = 292
    End With
    With .Add(Type:=msoControlButton, Before:=1, temporary:=True)
      .Caption = Captionnaam1
      .OnAction = Aktie1
      .Tag = Tagnaam
      .FaceId = 295
    End With
  End With
End Sub

Sub MenuVerwijderen()
  On Error Resume Next
  CommandBars("Cell").Controls(Captionnaam1).Delete
  CommandBars("Cell").Controls(Captionnaam2).Delete
End Sub

Ik denk dat de macro mijn verhaal iets duidelijker maakt.