|
Dann vielleicht so:
Zuerst alle nötigen Zellen in Zeile ändern, dann in die Zelle der Spalte A klicken,
LeadNr. wird gesuch und die Zelle geändert.
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Application.ScreenUpdating = False
Dim RaBereich As Range, RaZelle As Range
Set RaBereich = Range("A3:K10000") 'Bereich Änderung
Application.EnableEvents = False
For Each RaZelle In Range(Target.Address)
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
If RaZelle.Value <> "" Then 'geändert ?
'Range(Cells(RaZelle.Row, 1), Cells(RaZelle.Row, 1)).Select 'Spalte A selber klicken
Dim j As Integer
EndeQ = Worksheets("Blatt1").Cells(Rows.Count, 1).End(xlUp).Row 'Spalte A
For j = 1 To EndeQ
If ActiveCell.Offset(0, 0) = Sheets("Blatt1").Cells(j, 1) Then 'Ist in Blatt1 LeadNr. vorhanden?
Range(Cells(RaZelle.Row, 1), Cells(RaZelle.Row, 11)).Copy
Sheets("Blatt1").Select
Sheets("Blatt1").Cells(j, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
End If
Next j
End If
Application.EnableEvents = True
Set RaBereich = Nothing
End If
Next RaZelle
Sheets("Blatt2").Select
Application.ScreenUpdating = True
End Sub
|