VBA Wert gegenchecken
13.08.2019 14:12:11
Raphael
vor einer Woche ca. wurde mir hier schonmal geholfen.
Nun muss ich bei der VBA nochmals eine kleine Änderung vornehmen, stehe aber abermals wie der Ochse vorm Berg...
Folgendes:
die aktuelle ist soweit richtig. ich gebe in Sheet "Mitarbeiter2019" Daten ein. Diese werden über eine Formel asugewertet. Anschließend wird über das VBA der Wert kopiert und immer wieder untereinander im Sheet "Übersicht2019" eingesetzt. Soweit so gut. Nur habe ich eine kleinigkeit übersehen:
Falls die Daten, die ich in "Mitarbeiter2019" eingegeben habe nicht richtig sind, kann ich diese ja dort ändern. Allerdings werden dann die alten Daten nicht überschrieben, sondern die nächste zeile wird befüllt.
Ich bräuchte also einen Gegencheck, der die KW in "Mitarbeiter2019" (Zelle H6) mit der in "Übersicht2019" (diese befinden sich in D4:D56) vergleicht. Sollte diese gleich sein, sollten die Werte überschrieben werden, falls ungleich, in die nächste Zeile...
hier ist der Code:
Sub aktualisieren2019()
'kopieren des Datums aus Zelle H5 in Mitarbeiter nach Übersicht2019
Application.ScreenUpdating = False
With Worksheets("Übersicht2019")
Dim a As Long
a = .Cells(Rows.Count, 2).End(xlUp).Row + 1 'a ist die erste leere Zelle in Spalte B
If .Range("B1") = "" Then b = 1
Worksheets("Mitarbeiter2019").Range("H5").Copy 'Wert aus Mitarbeiter wird kopiert
Range("B" & a).PasteSpecial Paste:=xlPasteValues 'Wert wird eingefügt
End With
Application.CutCopyMode = False 'Kopierspeicher leeren
'kopieren des Wertes aus Zelle H30 in Mitarbeiter nach Übersicht2019
With Worksheets("Übersicht2019")
Dim c As Long
c = .Cells(Rows.Count, 2).End(xlUp).Row + 1 'a ist die erste leere Zelle in Spalte B
If .Range("F1") = "" Then b = 1
Worksheets("Mitarbeiter2019").Range("H30").Copy 'Wert aus Mitarbeiter wird kopiert
Range("F" & a).PasteSpecial Paste:=xlPasteValues 'Wert wird eingefügt
End With
Application.CutCopyMode = False 'Kopierspeicher leeren
'kopieren des Wertes aus Zelle Q18 in Mitarbeiter nach Übersicht2019
With Worksheets("Übersicht2019")
Dim d As Long
d = .Cells(Rows.Count, 2).End(xlUp).Row + 1 'a ist die erste leere Zelle in Spalte B
If .Range("G1") = "" Then b = 1
Worksheets("Mitarbeiter2019").Range("Q18").Copy 'Wert aus Mitarbeiter wird kopiert
Range("G" & a).PasteSpecial Paste:=xlPasteValues 'Wert wird eingefügt
End With
Application.CutCopyMode = False 'Kopierspeicher leeren
Application.ScreenUpdating = True 'Aktualisierung einschalten
End Sub
Bis hierhin schon einmal vielen Dank!
LG,
Raphael