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 vier aufeinanderfolgende Spalten
Dim WSh As Worksheet, iZeile As Long, xBeginn As Integer, Sp As String
Set WSh = Sheets("Datenbank")
On Error Resume Next
With Target
If .Value = "" Then Exit Sub
xBeginn = ((.Column - 1) \ 4) * 4 + 1
Sp = Chr$((.Column + 65 - xBeginn))
iZeile = Application.WorksheetFunction.Match(.Value, _
WSh.Range(Sp & ":" & Sp), 0)
If iZeile > 0 Then
Cells(.Row, xBeginn).Resize(, 4).Value = WSh.Cells(iZeile, 1).Resize(, 4).Value
End If
End With
End Sub
|