Guten Tag,
ich habe nicht weitergedacht.
Meine Datei soll als Vorlage dienen. Der Schichtführer möchte jeden Tag in der Frühschicht für den neuen Arbeitstag mit aktuellem Datum eine Datei erstellen.
Deshalb ist meine Idee mit dem Arbeitsblatt "2023" in der gleichen Datei falsch. Ich brauche eine zusätzliche Datei mit dem Titel "2023" mit dem Arbeitsblattname "2023". Ich habe diese Hürde lösen können, nicht unbedingt professionell. Dafür habe ich folgende Ergänzungen gemacht (die Fettschriften):
Sub schicht()
Dim wksQuelle As Worksheet
Dim dDatum As Date
Dim lngZeile As Long
Dim Ergebnis
Dim Antwort
Dim y As Workbook
'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False
'Name des Quellarbeitsblattes in Variable schreiben
Set wksQuelle = ActiveSheet
'Datum einlesen
dDatum = wksQuelle.Range("B6")
'Öffne die Datei "2023"
Set y = Workbooks.Open("C:\Users\Zagor\Desktop\2023.xlsx")
'Datum suchen
With Worksheets("2023")
With .Range("A:A")
Set Ergebnis = .Find(dDatum, LookIn:=xlValues, lookat:=xlPart)
End With
If Ergebnis Is Nothing Then
'Meldung ausgeben, falls Datum nicht gefunden wurden
MsgBox "Das Datum " & dDatum & " wurde leider nicht gefunden! Abbruch", 0, "Suche abgeschlossen"
Exit Sub
Else
'Zeile von gefundenem Datum in Variable schreiben
lngZeile = Ergebnis.Row
End If
'Prüfen, ob in dem Einfügebereich bereits etwas steht - mit ANZAHL2
If Application.CountA(.Range(.Cells(lngZeile, 2), .Cells(lngZeile, 11))) > 0 Then
'Nachfrage, ob vorhandene Daten überschrieben werden sollen
Antwort = MsgBox("Bei dem Datum " & dDatum & " sind bereits Daten vorhanden. Sollen diese überschrieben werden?", 36, "Bereits Daten vorhanden")
'Bei Nein als Anwort, Makro beenden
If Antwort = vbNo Then Exit Sub
End If
'Daten ins Jahres-Arbeitsblatt übertragen
.Cells(lngZeile, 2) = wksQuelle.Range("W3")
.Cells(lngZeile, 3) = wksQuelle.Range("W4")
.Cells(lngZeile, 4) = wksQuelle.Range("W5")
.Cells(lngZeile, 5) = wksQuelle.Range("W6")
.Cells(lngZeile, 6).FormulaLocal = "=Summe(" & .Cells(lngZeile, 2).Address & ":" & .Cells(lngZeile, 5).Address & ")"
.Cells(lngZeile, 7) = wksQuelle.Range("M3")
.Cells(lngZeile, 8) = wksQuelle.Range("M4")
.Cells(lngZeile, 9) = wksQuelle.Range("M5")
.Cells(lngZeile, 10) = wksQuelle.Range("M6")
.Cells(lngZeile, 11).FormulaLocal = "=Summe(" & .Cells(lngZeile, 7).Address & ":" & .Cells(lngZeile, 10).Address & ")"
'auf Tabellenblatt wechseln
.Activate
End With
'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True
'Speichere y:
y.Save
'Schließe y:
y.Close
End Sub
Ich brauche Hilfe bei den unteren Punkten:
- Wenn die Zeilen überschrieben sind, und ich "Nein, bitte die Zeile nicht überschreiben " betätige, dann bleibt die Datei "2023.xlsx" offen. Ich muss sie manuell schließen.
- Ich hätte es gern, wenn beim Schließen der nach dem aktuellen Datum erstellten-Datei die Daten in die Datei "2023.xlsx" kopiert werden könnten.