Formel nicht mit kopieren
13.06.2020 13:47:08
Uli
zwei nette Mitglieder aus dem Forum hier haben mir Gestern den Code unten angepasst.
Nun habe ich in dem Eingabeformular "Frühschicht" in Zelle C74 immer die Manuelle Datumsangabe. Möchte aber das immer das Datum vom aktuellen Tag dort steht damit niemand vergisst es einzutragen. Habe in die Zelle also =Heute() eingetragen.
Nachdem das Makro ausgeführt wird wird aber die Formel in die Ziel Tabelle eingefügt . Es sollte dort allerdings das Datum ohne die Formel stehen. Da sich das Datum ja Täglich ändert und dann nicht mehr nachzuvollziehen ist, wann der Eintag gemacht wurde.
Was muss man ändern damit nur das Datum kopiert wird und nicht auch die Formel ?
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 Luschi
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)
'Workbooks(sDatei).Close SaveChanges:=True
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