Excel, Schreibschutz auf einzelne Zellen

Private Sub Workbook_BeforePrint(Cancel As Boolean)
  
  Dim ws As Worksheet, s_Blattname As String, x As Long
  Dim BlaetterAufDrucker As Variant
  Dim Old_Drucker As String, Spezieller_Drucker As String
  
 ->*** paarweise Angabe Blatt/Drucker,
 ->*** wenn Blatt nur auf einem bestimmten Drucker ausgegeben werden soll
 ->*** in diesem Fall nur Blatt->Tabelle1' und->Tabelle3'
  BlaetterAufDrucker = Array( _
                          Tabelle1, Druckername1, _
                          Tabelle3, Druckername2)
  
 ->*** Blattnamen des aktiven Blattes
  s_Blattname = ActiveSheet.Name
  
 ->*** Spezialbehandlung für Blatt?
  Spezieller_Drucker = 
  For x = LBound(BlaetterAufDrucker) To UBound(BlaetterAufDrucker) Step 2
    If s_Blattname = BlaetterAufDrucker(x) Then
      Spezieller_Drucker = BlaetterAufDrucker(x + 1)
      Exit For
    End If
  Next
  
  If Spezieller_Drucker <>  Then
    
    Old_Drucker = Application.ActivePrinter->alten Druckernamen sichern
    
   ->speziellen Drucker einstellen
    On Error Resume Next
    Application.ActivePrinter = Spezieller_Drucker
    If Err.Number <> 0 Then
      MsgBox (Err.Description & vbLf & _
        Drucker-> & Spezieller_Drucker &-> konnte nicht eingestellt werden.)
      Err.Clear
      On Error GoTo 0
      Exit Sub
    End If
    
    ws.PrintOut Copies:=1                   'Blatt ausdrucken
    Application.ActivePrinter = Old_Drucker->alten Druckernamen restaurieren
    Cancel = True                           'Druckdialog unterdrücken
  End If
  
End Sub

Sub DruckernamenAusgeben()
  Dim s_tmp As String
  s_tmp = InputBox( _
    Name des aktiven Druckers, _
    Name des aktiven Druckers, _
    Application.ActivePrinter)
End Sub