Köszönöm szépen,
dann probiers so:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim y As Long
If Target.Column = 9 Or Target.Column = 11 Or Target.Column = 13 Or Target.Column = 15 Then
If Target.Row > 61 Then ' Hier erst ab Zeile 62 das makro ausgeführt
On Error GoTo fehler
y = Target.Row
Dim da As Boolean
Dim r As String, s As String, t As String
Dim z As Long, re As Long, e As Long, sp As Long
da = False
r = Target.Value
s = Left(r, 4)
If Right(s, 1) = "/" Then
s = Left(r, 3)
Else
If Right(s, 2) = "/1" Or Right(s, 2) = "/2" Or Right(s, 2) = "/3" Or Right(s, 2) = "/4" _
Or Right(s, 2) = "/5" Or Right(s, 2) = "/6" Then
s = Left(r, 2)
End If
End If
t = Right(r, 1)
With Sheets("0")
e = .Range("A65536").End(xlUp).Offset(0, 0).Row
For z = 14 To e Step 2 'Hier wird erst ab Zeile 14 gesucht
If .Cells(z, 1).Value = s Then
re = .Cells(z, 1).Row
da = True
For sp = 9 To 14 Step 1
If .Cells(6, sp).Value = t Then
Target.Offset(0, -1).Value = .Cells(z, sp).Value
End If
Next sp
Exit For
End If
Next z
If da = False Then
MsgBox "Eintrag nicht vorhanden"
End If
End With
End If
Else
If Target.Column = 17 Or Target.Column = 19 Or Target.Column = 21 Or Target.Column = 23 Then
If Target.Row > 61 Then ' Hier erst ab Zeile 62 das makro ausgeführt
On Error GoTo fehler1
y1 = Target.Row
Dim da1 As Boolean
Dim r1 As String, s1 As String, t1 As String
Dim z1 As Long, re1 As Long, e1 As Long, sp1 As Long
da1 = False
r1 = Target.Value
s1 = Left(r1, 4)
If Right(s1, 1) = "/" Then
s1 = Left(r1, 3)
Else
If Right(s1, 2) = "/1" Or Right(s1, 2) = "/2" Or Right(s1, 2) = "/3" Or Right(s1, 2) = _
"/4" Or Right(s1, 2) = "/5" Or Right(s1, 2) = "/6" Then
s1 = Left(r1, 2)
End If
End If
t1 = Right(r1, 1)
With Sheets("0")
e1 = .Range("A65536").End(xlUp).Offset(0, 0).Row
For z1 = 14 To e1 Step 2 'Hier wird erst ab Zeile 14 gesucht
If .Cells(z1, 1).Value = s1 Then
re1 = .Cells(z1, 1).Row
da1 = True
For sp1 = 15 To 20 Step 1
If .Cells(6, sp1).Value = t1 Then
Dim l As Long, m As Long
Dim h As String
Target.Offset(0, -1).Value = .Cells(z1, sp1).Value
l = Target.Offset(0, -1).Row
m = Target.Offset(0, -1).Column
Cells(l + 1, m).Value = .Cells(z1 + 1, sp1).Value
End If
Next sp1
Exit For
End If
Next z1
If da1 = False Then
MsgBox "Eintrag nicht vorhanden"
End If
End With
End If
End If
End If
fehler:
Exit Sub
fehler1:
Exit Sub
End Sub
Habe jetzt das Makro so veraendert, dass erst ab Zeile 62 das Makro in Tabelle Terra... ausgeführt wird und die Sucherei erst ab Zeile 14 in Tabelle("0") beginnt.
Wenn du jetzt obendran irgendwas veraenderst, sollte nichts passieren. Ansonsten poste die andere Datei, ich kann mich aber erst ab Samstag darum kümmern.
Makro in Tabelle terra... einfügen und das andere rauslöschen.
Üdvözlök (Gruss)
Chaos