Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim objComment As Comment
Dim objCell As Range
Dim lngReturn As Long
On Error Resume Next
If Not Intersect(Target, Cells(1, 3).Resize(10, 1)) Is Nothing Then
On Error GoTo 0
With Target
If .Count = 1 Then
On Error Resume Next
lngReturn = .Validation.Type
On Error GoTo 0
If lngReturn <> 0 Then
If .Comment Is Nothing Then
Set objComment = .AddComment
Else
Set objComment = .Comment
End If
On Error Resume Next
Set objCell = Tabelle2.Range(Mid$(String:=.Validation.Formula1, Start:=2)).Find( _
What:=.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
On Error GoTo 0
If Not objCell Is Nothing Then
With objCell
If Not .Comment Is Nothing Then
With .Comment
With .Shape
objComment.Shape.Width = .Width
objComment.Shape.Height = .Height
End With
Call objComment.Text(Text:=.Text)
End With
End If
End With
Set objCell = Nothing
End If
Set objComment = Nothing
End If
End If
End With
End If
End Sub