Thema Datum  Von Nutzer Rating
Antwort
Rot Neue Zeilen werden vom Blattschutz nicht berücksichtigt
 01.04.2020 15:08:11 Helena00
NotSolved
01.04.2020 15:22:27 Torsten
*****
Solved
01.04.2020 15:27:50 Helena00
NotSolved
01.04.2020 15:33:46 Torsten
NotSolved

Ansicht des Beitrags:
Von:
Helena00		 Datum:
01.04.2020 15:08:11		 Views:
1236		 Rating:
     
Antwort:
  Ja
Thema:
Neue Zeilen werden vom Blattschutz nicht berücksichtigt

Hallo, 

ich stecke fest bei meinem VBA-Tool. 

Undzwar ist das Problem folgendes: 

Ich kpiere von einem Sheet ins andere Daten , diese Sheet hat einen Blattschutz den ich natürlich am Anfang aufhebe und am Ende wieder aktiviere. 

Allerdings schützt er die von mir neu eingefügten Zeilen nicht , s das man immernoch darauf zugreifen kann. 

Gibt es dafür einen Befehl dass, eventuel alle neu eingefügten Zeilen auch geschützt werden. 

Hier ist der Code 

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
Sub Stoerung_behoben()
    
   'Blattschutz deaktivieren
   Sheets("Fehlersammelliste").Unprotect Password:="JTI-2020"
 
 
Range("I7") = Date & " " & Format(Time, "hh:mm:ss")
Worksheets("Fehlersammelliste").Activate
' Zeileeinfügen Makro
    Rows("4:4").Select
    Selection.Insert Shift:=x1Down, CopyOrigin:=xlFormatFromLeftOrAbove
 
 
Sheets("Eintragungen").Range("A7").Copy Sheets("Fehlersammelliste").Range("B4")
Sheets("Eintragungen").Range("I7").Copy Sheets("Fehlersammelliste").Range("C4")
 
 
Dim Zeit1 As Date
Dim Zeit2 As Date
Dim Sek As Long
Dim Min As Long
Dim Std As Long
 
 
Zeit1 = Sheets("Fehlersammelliste").Range("B4")
Zeit2 = Sheets("Fehlersammelliste").Range("C4")
 
Sek = DateDiff("s", Zeit1, Zeit2)
 
Std = Int(Sek / 3600)
Min = Int((Sek - (Std * 3600)) / 60)
Sek = Sek - ((Std * 3600) + (Min * 60))
Sheets("Fehlersammelliste").Range("D4").Value = Std & ":" & Min & ":" & Sek
 
 
Sheets("Eintragungen").Range("C7").Copy Sheets("Fehlersammelliste").Range("E4")
Sheets("Eintragungen").Range("D7").Copy Sheets("Fehlersammelliste").Range("F4")
Sheets("Eintragungen").Range("E7:E7").Copy Sheets("Fehlersammelliste").Range("G4:G4")
'Sheets("Eintragungen").Range("H7:I7").Copy Sheets("Fehlersammelliste").Range("I4:I4")
'Sheets("Eintragungen").Range("L7").Value = Sheets("Eintragungen").Range("L7").Value + 1
Sheets("Eintragungen").Range("L7").Copy Sheets("Fehlersammelliste").Range("A4")
Sheets("Eintragungen").Range("A7").ClearContents
Sheets("Eintragungen").Range("C7:D7").ClearContents
Sheets("Eintragungen").Range("E7:F7").ClearContents
Sheets("Eintragungen").Range("H7:I7").ClearContents
Sheets("Eintragungen").Range("I7").ClearContents
' Rücksprung Anfang
Sheets("Eintragungen").Select
Range("C7").Select
'Autosummation der Firmenauswertung
'Optima
 
Worksheets("Fehlersammelliste").Range("K2") = _
   WorksheetFunction.SumIf(Range("Fehlersammelliste!G4:G1000"), "Optima", Range("Fehlersammelliste!D4:D1000"))
 
Worksheets("Fehlersammelliste").Range("L2") = _
   WorksheetFunction.SumIf(Range("Fehlersammelliste!G4:G1000"), "JTI", Range("Fehlersammelliste!D4:D1000"))
    
Worksheets("Fehlersammelliste").Range("M2") = _
   WorksheetFunction.SumIf(Range("Fehlersammelliste!G4:G1000"), "Hoerauf", Range("Fehlersammelliste!D4:D1000"))
 
Worksheets("Fehlersammelliste").Range("N2") = _
   WorksheetFunction.SumIf(Range("Fehlersammelliste!G4:G1000"), "Emkon1", Range("Fehlersammelliste!D4:D1000"))
    
Worksheets("Fehlersammelliste").Range("O2") = _
   WorksheetFunction.SumIf(Range("Fehlersammelliste!G4:G1000"), "Emkon2", Range("Fehlersammelliste!D4:D1000"))
 
 'Blattschutz aktivieren
 Sheets("Fehlersammelliste").Protect Password:="JTI-2020"
 
End Sub

 

Vielen Dank schonmal

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:
WYSIWYG-Editor, ctl00_Content_editor1



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Neue Zeilen werden vom Blattschutz nicht berücksichtigt
 01.04.2020 15:08:11 Helena00
NotSolved
01.04.2020 15:22:27 Torsten
*****
Solved
01.04.2020 15:27:50 Helena00
NotSolved
01.04.2020 15:33:46 Torsten
NotSolved