01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18 |
|
Private Sub Worksheet_Change(ByVal Target As Range)
' Für drei aufeinanderfolgende Spalten
Dim WSh As Worksheet, iZeile As Long, xBeginn As Integer, Sp As String
xBeginn = 4 ' Spalte "D"
Set WSh = Sheets("Datenbank")
On Error Resume Next
With Target
If .Column < xBeginn Or .Column > xBeginn + 2 Or .Value = "" Then Exit Sub
Sp = Chr$((.Column + 65 - xBeginn))
iZeile = Application.WorksheetFunction.Match(.Value, _
WSh.Range(Sp & ":" & Sp), 0)
If iZeile > 0 Then
Cells(.Row, xBeginn).Resize(, 3).Value = WSh.Cells(iZeile, 1).Resize(, 3).Value
End If
End With
End Sub
|