liebenswerterweise hat mir Renée einen Code zur Verfügung gestellt, der es ermöglicht,
Daten per DropDown in einem TabBlatt anzuzeigen und auch zu verändern.
Funktioniert soweit auch alles bestens und wie gewünscht.
Allerdings nach Anpassung in einer neuen Arbeitsmappe, funktioniert er leider nicht mehr
und ich weiß absolut nicht warum.
Vielleicht sieht jemand von euch, einen von mir verursachten Fehler, denn wie bereits ge-
sagt...in der Beispieldatei https://www.herber.de/bbs/user/68747.xls
von Renée funktioniert
alles einwandfrei.
Hier mein angepasster Code:
Option Explicit
Public pubBolChanged As Boolean
Public pubLngRow As Long
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$I$2" Then
WriteValues
ReadValues Target
End If
If Not Intersect(Target, Range("I3:I4,U2:U4,AD2,AN2")) Is Nothing Then pubBolChanged = True
End Sub
Private Sub Worksheet_Deactivate()
WriteValues
End Sub
Sub ReadValues(rngTarget As Range)
pubLngRow = WorksheetFunction.Match(rngTarget, Tabelle19.Range("A:A"), 0)
Application.EnableEvents = False
Cells(3, 9) = Tabelle19.Cells(pubLngRow, 2) 'Eintritt
Cells(4, 9) = Tabelle19.Cells(pubLngRow, 3) 'Austritt
Cells(2, 21) = Tabelle19.Cells(pubLngRow, 4) 'Tel
Cells(3, 21) = Tabelle19.Cells(pubLngRow, 5) 'Zugehörigkeit
Cells(4, 21) = Tabelle19.Cells(pubLngRow, 6) 'Abteilung
Cells(2, 30) = Tabelle19.Cells(pubLngRow, 7) 'Resturlaub Vorjahr
Cells(2, 40) = Tabelle19.Cells(pubLngRow, 8) 'Anspruch lf Jahr
Application.EnableEvents = True
End Sub
Sub WriteValues()
If pubBolChanged Then
If vbOK = MsgBox("Werte für " & Tabelle19.Cells(pubLngRow, 1).Text & vbCrLf & _
"zurückschreiben ?", vbExclamation + vbOKCancel) Then
Tabelle19.Cells(pubLngRow, 2) = Cells(3, 9) 'Eintritt
Tabelle19.Cells(pubLngRow, 3) = Cells(4, 9) 'Austritt
Tabelle19.Cells(pubLngRow, 4) = Cells(2, 21) 'Tel
Tabelle19.Cells(pubLngRow, 5) = Cells(3, 21) 'Zugehörigkeit
Tabelle19.Cells(pubLngRow, 6) = Cells(4, 21) 'Abteilung
Tabelle19.Cells(pubLngRow, 7) = Cells(2, 30) 'Resturlaub Vorjahr
Tabelle19.Cells(pubLngRow, 8) = Cells(2, 40) 'Anspruch lf Jahr
End If
pubBolChanged = False
End If
End Sub
LG
Antoinette