Clever-Excel-Forum

Hallo

Habe da eine Frage zu VBA. Ich habe da eine Schaltfläche "Aktualisieren" in meiner Datei.

Ich möchte aber das Tabellenblatt schützen, ein Passwort brauche ich dazu nicht.

Wenn ich das Blatt aber schütze, kommt dann die Meldung Laufzeitfehler 1004; ich soll den Schreibschutz auflösen.

Unten angefügt der bestehende Code. Gibt es dazu eine Lösung?


Sub Schaltfläche2_Klicken()
   Call zusammenfassen
End Sub

Sub zusammenfassen()
   Dim i As Long
   Dim lngLetzte As Long
   Dim vntA
   Dim feld
   Dim objDic1
   Set objDic1 = CreateObject("Scripting.Dictionary")
 
   'Überschriften
   vntA = Array("Order", "KND-Nr.", "Kunde", "Umsatz")
 
   Application.ScreenUpdating = False                   'Bildschirmaktualisierung aus
 
   With Worksheets("AB2015")
      .Columns("g:j").ClearContents                    'Inhalte der Spalten "AC:AF" löschen
      .Range("g3:j3") = vntA                           'Überschriften in den Bereich "AC3:AF3" eintragen
      lngLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row   'letzte belegte Zeile in Spalte A
      feld = .Range("A4:E" & lngLetzte)                  'Bereich AC3 bis AF bis zur letzten belgeten in ein Variant Array schreiben
      For i = LBound(feld) To UBound(feld)               'Alle Array Zeilen durchlaufen
         If feld(i, 1) <> 0 Then                         'wenn Zelle in Spalte nicht 0 dann einlesen
            objDic1(feld(i, 1)) = objDic1(feld(i, 1)) + feld(i, 4)   'Unicate in Dictionary einlesen und die Spalte D aufaddieren
         End If
      Next i
      
      'Daten in die entsprechenden Saplten schreiben
      .Range("h4:h" & objDic1.Count + 3) = WorksheetFunction.Transpose(objDic1.keys) 'Unicate in Spalte AD
      .Range("g4:g" & objDic1.Count + 3) = WorksheetFunction.Transpose(objDic1.items) 'Summen von "St" in Spalte AC
      .Range("i4:i" & objDic1.Count + 3).FormulaLocal = "=SVERWEIS(h4;$A$4:$B$" & lngLetzte & ";2;0)" 'In Spalte AE SVERWEIS() Formel zur Ermittlung der Kundennamen
      .Range("j4:j" & objDic1.Count + 3).FormulaLocal = "=SUMMEWENN($A$4:$A$" & lngLetzte & ";h4;$E$4:$E$" & lngLetzte & ")" ''In Spalte h SUMMEWENN()() Formel zur Ermittlung der Kundennamen
      .Range("i4:i" & objDic1.Count + 3).Value = .Range("i4:i" & objDic1.Count + 3).Value 'Formeln mit ihren Werten überschreiben
      .Range("j4:j" & objDic1.Count + 3).Value = .Range("j4:j" & objDic1.Count + 3).Value ''Formeln mit ihren Werten überschreiben

      
      'erst nach Spalte AC dann nach Spalte AF absteigend sortieren
       .Range("g3:j" & objDic1.Count + 3).Sort Key1:=.Range("g4"), Order1:=xlDescending, Key2:=.Range("j4"), Order2:=xlDescending, Header:=xlYes, _
           OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
           DataOption1:=xlSortNormal
 
   End With
 
   Application.ScreenUpdating = True   'Bildschirmaktualisierung ein

End Sub



LG
cuba

Hallo,


Gruß Uwe

Hallo Uwe

Vielen Dank für die schnelle Lösung. ABER: Wo soll ich das einfügen?

LG
cuba

Erledigt, funktioniert tadellos!!!

Vielen Dank

LG
cuba

Hallo,

Danke Stefan

Es hat bereits funkitoniert

LG
cuba