Hallo,
ich habe ein Exceldatei mit zwei Tabellen, wo folgendes aktuell beim speichern der Datei passiert:
- Beim speichern wird in der Tabelle "Zeiten" die Zeile A2 bis H2 in die Tabelle Technik ab Zeile A2 kopiert. Klicke ich ein weiteres mal auf speichern, so werden die Daten von den Zeilen nochmals
in die Tabelle Technik kopiert, aber dann unten angefügt. Das funktioniert auch wunderbar. Jetzt benötige ich folgende Bedingung:
- Sollte in der Tabelle Zeiten in der Spalte "A" (KW) bsp. die 3 KW stehen, dann sollte die Zeile in der Tabelle "Technik" nach dem Speichervorgang unten angefügt werden, steht aber bereits in der Tabelle "Technik" die 2 KW
drin, so sollen die Daten überschrieben werden. Also, ist KW in beiden Tabellen gleich, das bedeutet die Daten wurden bereits transferiert, so wird immer weiter überschrieben, bis dann eine andere Kalenderwoche in der Zeiten
Tabelle auftaucht, denn dann wird wieder angefügt. Ist so was möglich ?
LG
Kathrin
Hallo Kathrin,
so sollte es gehen.
Hi,
schon mal danke für deine Hilfe, zum Teil funktioniert es, aber leider überschreibt er nicht.
Beispielsweise ich ändere einen Wert in der Tabelle Zeiten und die KW ist in beiden Tabellen gleich, so sollte auch der Wert mit in die Tabelle Technik übernommen werden. Geht aber irgendwie nicht.
LG
Hi,
in Deiner Demo wird jede Zeile einzeln berechnet, kann das wirklich vorkommen das die Zeile aus "Zeiten" an unterschiedlichen Zeilen in Technik soll?
Das geht natürlich nicht.
Ich versuche es nochmal besser zu beschreiben, denn ich habe es vielleicht auch ein wenig blöd dargestellt.
1. Ich drücke speichern und die Zeile A2:H2 aus der Tabelle "Zeiten" wird in die Tabelle Technik, ab Zeile A2 eingefügt
2. Sollte beim nächsten speichern die gleiche KW in beiden Tabellen stehen, so sollen die Daten in der Tabelle Technik (A2) überschrieben werden.
3. Sollte beim speichern aber eine andere KW stehen, dann soll diese in der Tabelle Technik (A3) unten angefügt werden
Info: Die Prüfung der KW bezieht sich in der Tabelle Technik nur auf die letzte Zeile der Tabelle
Hi,
ich hoffe, dass es jetzt das ist, was Du brauchst.
PERFEKT, genau so hatte ich mir das vorgestellt.
Vielen herzlichen Dank
Hallo,
dafür braucht es keine eigene Function. Zudem würde ich die Quelldaten im Block kopieren und nicht einzeln ins Ziel schreiben.
Code:
Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim loLetzte As Long
Application.ScreenUpdating = False
With Worksheets("Technik")
loLetzte = .Cells(.Rows.Count, "A").End(xlUp).Row
If Worksheets("Zeiten").Cells(2, "A") <> .Cells(loLetzte, "A") Then
loLetzte = loLetzte + 1
End If
Worksheets("Zeiten").Range("A2:H2").Copy
.Cells(loLetzte, "A").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End With
Application.CutCopyMode = False
End Sub
Gruß Werner
Hallo,
besteht bei meinem Problem auch die Möglichkeit, dass ich das mit einem ganzen Block so durchführe, also es werden dann 21 Zeilen sein, die im Block immer die gleiche KW haben. Sollte ich also speichern klicken, dann
soll die KW geprüft werden und wenn es die gleiche ist wie in der Zeiten Tabellen dann sollen alle Werte überschrieben werden, ansonsten bei einer anderen KW soll der neue Block mit 21 Zeilen unten angefügt werden, usw.
Schon genau wie in der Beispieldatei, mit dem Unterschied, das nicht nur eine Zeile betrachtet wird, sondern 21 Zeilen. Die KW´s werden, wenn sie geändert werden, immer für alle (21 Zeilen geändert).
Liebe Grüße
Kathrin
Hallo,
meinst du so?
Code:
Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim loLetzte As Long, raFund As Range
Application.ScreenUpdating = False
With Worksheets("Technik")
Set raFund = .Columns("A").Find(what:=Worksheets("Zeiten").Range("A2"), LookIn:=xlValues, lookat:=xlWhole)
If Not raFund Is Nothing Then
Worksheets("Zeiten").Range("A2:H22").Copy _
.Range("A" & raFund.Row).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Else
Worksheets("Zeiten").Range("A2:H22").Copy
.Range("A" & .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Row).PasteSpecial _
Paste:=xlPasteValuesAndNumberFormats
End If
End With
Application.CutCopyMode = False
Set raFund = Nothing
End Sub
Gruß Werner