kopiëren door dubbelklik

[Gerard2348]

Best forum leden,

Graag wil ik dmv dubbelklikken waarde van uit range ("G18:T40") kopiëren naar range ("R3:T15"). Dit lukt mij ten dele. De eerste klik is geen probleem. Bij de tweede klik moet de waarde onder de eerst verkregen waarde komen. Dit lukt mij niet. Wat is fout in de code.

Groet Geer

Bekijk bijlage dubbelklik.xlsm

 

[VenA]

Probeer het zo eens.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Intersect(Target, Range("H15:H50,M15:M50,R15:R50")) Is Nothing Then Exit Sub
  Cells(14, 18).End(xlUp).Offset(1).Resize(, 2) = Target.Resize(, 2).Value
End Sub

 

[Gerard2348]

Ha VenA,

Werkt als een tierelier. Mijn hartelijke dank :thumb:

 

[Gerard2348]

Toch nog een vraagje. De code werkt, zoals ik al eerder zei, geweldig. Maar is het mogelijk dat wanneer er uit de range ("R3:T15") een waarde wordt verwijderd de rest van de range waar waardes instaan naar boven wordt verplaats.

 

[VenA]

Bv.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("R3:R13")) Is Nothing Or Target.Count > 1 Then Exit Sub
  If Target = "" Then
    Application.EnableEvents = False
    With Target.Offset(1).Resize(14 - Target.Row, 2)
      .Cut Target
      .BorderAround xlContinuous
      .Borders(xlInsideVertical).LineStyle = xlContinuous
      .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With
    Application.EnableEvents = True
  End If
End Sub

 

[HSV]

With Target.Offset(1).Resize(14 - Target.Row, 2)
      .Cut Target
      .Borders.LineStyle = xlContinuous
   End With

 

[VenA]

@HSV,

Die zocht ik. Dat het met 1 regel kan wist ik maar zat te zoeken in 'xlbordersindex':d

 

[Gerard2348]

wow,
een stelletje kanjers dat zijn jullie...:thumb::d