AW: Mit Doppelklick zelle kopieren
16.08.2011 19:44:49
Uwe
Nochmal hallo,
ich habe jetzt mal etwas "zusammengeschustert":
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim lLetzte As Long
Dim rngSuchen As Range
Set rngSuchen = Sheets("verkoop").Range("B9:B100"). _
Find(What:=Cells(Target.Row, 2).Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:= _
xlByColumns)
If rngSuchen Is Nothing Then
lLetzte = Sheets("verkoop").Cells(Rows.Count, 2).End(xlUp).Row
'If lLetzte
Bei meinen ersten Tests, klappt es, so wie ich es verstanden habe.
Teste aber unbedingt nochmal ausführlich: Keine Garantie (;o).
Das If lLetzte
Ich habe den Rest so gelassen, wie Du ihn hattest.
Du kannst Dir allerdings das kopieren sparen, wenn Du es so machst (DAS wäre meine Version):
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim lLetzte As Long
Dim rngSuchen As Range
Set rngSuchen = Sheets("verkoop").Range("B9:B100"). _
Find(What:=Cells(Target.Row, 2).Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:= _
xlByColumns)
If rngSuchen Is Nothing Then
lLetzte = Sheets("verkoop").Cells(Rows.Count, 2).End(xlUp).Row
Sheets("verkoop").Cells(lLetzte + 1, 2).Value = Cells(Target.Row, 2).Value
Sheets("verkoop").Cells(lLetzte + 1, 3) = "1"
Else: rngSuchen.Offset(0, 1) = rngSuchen.Offset(0, 1) + 1
End If
ActiveCell.Offset(1, 0).Select
End Sub
Gruß
Uwe
(:o)