Blattschutz an und aus
15.06.2020 08:39:37
Uli
in dem unten stehenden Code wird von Datei "Frühschicht" in die Datei "Action Plan" Werte übergeben.
Sobald ein Wert in der Spalte B in Action Plan eingetragen wird, versendet Outlook eine Mail.
Wenn ich jetzt in der Tabelle Action_Plan die Spalte B den Blattschutz setze können keine Werte übertragen werden.
Meine Frage:
Wo nehme ich den Blattschutz raus und wo setze ich ihn wieder automatisch nachdem die Daten übergeben wurden ?
Danke und Gruß Uli
Public Sub Schreiben_PMV_Früh()
Application.ScreenUpdating = False
'schreibt in geschlossene PMV
Dim sPfad As String ' der Ordner-Pfad der Excel-Mappen
Dim sDatei As String ' die zu beschreibende Datei
Dim WkSh_Q As Worksheet ' das Quell-Tabellenblatt - die Herkunft
Dim WkSh_Z As Worksheet ' das Ziel-Tabellenblatt - das Ergebnis
Dim ersteFreieZelle As Long
'Pfad User
'sPfad = "C:\Users\ElCapitan\Desktop\Prüflehren\"
'Pfad Uli
sPfad = ThisWorkbook.Path & "\"
sDatei = "PT05_FB_0001_Aktions- und Maßnahmenplan_MB.xlsm"
' PT05_FB_0001_Aktions- und Maßnahmenplan_MB.xlsm
'Application.ScreenUpdating = False
If Dir(sPfad & sDatei, vbNormal) "" Then
Workbooks.Open (sPfad & sDatei)
ThisWorkbook.Activate
'Application.ActiveWindow.Visible = False
Else
MsgBox "Den angegebenen Ordner """ & sPfad & """" & Chr(10) & _
"und/oder die gesuchte Datei """ & sDatei & """ gibt es nicht!", _
16, " Hinweis für " & Application.UserName
Exit Sub
End If
Set WkSh_Q = ThisWorkbook.Worksheets("Frühschicht")
'alt
'Set WkSh_Z = Workbooks(sDatei).Worksheets("Action Plan_P992_077")
'neu
Set WkSh_Z = Workbooks(sDatei).Worksheets(WkSh_Q.Range("A74").Value)
ersteFreieZelle = WorksheetFunction.Max(7 - 1, WkSh_Z.Range("B29").End(xlUp).Row) + 1
WkSh_Q.Cells.Range("C74:E74").Copy Destination:=WkSh_Z.Range("B" & ersteFreieZelle & ":D" & _
_
_
ersteFreieZelle)
'datum in action plan schreiben
WkSh_Z.Range("B" & ersteFreieZelle) = Date
MsgBox "Die Daten wurden erfolgreich übergeben.", _
64, " Information für " & Application.UserName
With WkSh_Z.Parent
.Save
.Saved = True
'.Close False
End With
Set WkSh_Q = Nothing: Set WkSh_Z = Nothing
End Sub