VBA eerste lege rij zoeken en gegevens plakken

Status
Niet open voor verdere reacties.

Williewammes

Gebruiker
Lid geworden
12 mei 2020
Berichten
28
Ik heb een excel gemaakt waar er bij het klikken op een willekeurige cel in kolom D de waarde uit de cel in kolom E geplakt wordt in de cel in kolom D.
Vervolgens moet de hele rij gekopieerd worden en geplakt worden in de eerste lege rij in tabblad "Historie" (als log file).

Nu werkt het eerste kopieren en plakken prima en ook het selecteren en kopieren van de gehele rij werkt, alleen geeft hij de volgende foutmelding "Methode Activatie van klasse Range Mislukt".

Het eerste stuk van de code had ik een tijd geleden al via deze website verkregen en ik vermoed dat er aan het begin van de code iets staat waardoor dit laatste stukje code nu niet werkt.

graag jullie advies. Hieronder de code:

----------------------------

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 4 And Target.Row > 1 Then
If MsgBox("Opnieuw berekenen?", vbQuestion + vbYesNo, "Datum volgende controle") = vbYes Then Target = Target.Offset(, 1)
Cancel = True
ActiveCell.EntireRow.Select
Selection.Copy
Sheets("Historie").Activate
Range("A3").Activate
Selection.End(xlDown).Activate
ActiveCell.Offset(1, 0).Activate
ActiveCell.EntireRow.Select
Selection.Paste
End If
End Sub

--------------------

Vriendelijke groet,

W. Veldhuis
 
Kun je aangeven in welke draad in dit forum je deze code verstrekt zou zijn ?

Gebruik nooit 'Select' of 'Activate' in VBA.
Maar gebruik altijd Code tags als je VBA-code in je bericht opneemt: zie de forumregels.
 
Laatst bewerkt:
Uit de losse pols als je geen bestand plaatst.
Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 4 And Target.Row > 1 Then
 If MsgBox("Opnieuw berekenen?", vbQuestion + vbYesNo, "Datum volgende controle") = vbYes Then Target = Target.Offset(, 1)
    target.offset(,-3).resize(,usedrange.columns.count).Copy Sheets("Historie").cells(rows.count,4).end(xlup).offset(1)
    cancel = true
    End If
End Sub
 
Harry,

Hij werkt idd op deze manier. Ik moest alleen nog even de 4 achter Rows.count veranderen in 1 anders plakte hij de gegevens vanaf kolom D i.p.v. kolom A.
Bedankt voor de snelle oplossing. Ik ga blij het weekend in ;-)

Vriendelijke groet,

Wiljen
 
Ook als je op 'Nee' klikt in de MsgBox Wiljen?

Ik heb het maar klakkeloos overgenomen, anders moet dat een regel naar onderen en een 'End If' bijplaatsen.
 
Harry,

Als ik Nee druk vernieuwt hij niet de datum, maar plakt hij wel de regel in het andere tabblad (wat hij eigenlijk niet moet doen).
Daarnaast zou ik graag willen dat hij alleen de waardes van de cellen overneemt (en dus niet de formules en opmaak e.d.).
En als laaste dat hij in kolom F van tabblad "Historie" de datum van vandaag plakt, maar dan weer alleen als waarde (Als ik hem morgen opnieuw open moet hij dus niet de datum van morgen weergeven).

En als het helemaal perfect mag, dan zou ik het liefst willen dat ik in het tabblad "historie" de verborgen kolommen helemaal weg kan laten. Maar mocht dat niet lukken is het geen grote ramp.

Ik zal het bestand ook even uploaden, dat werkt wellicht wat handiger of niet?

Gr,

Wiljen
 

Bijlagen

  • Preventief onderhoud rev3.xlsm
    38,6 KB · Weergaven: 20
Laatst bewerkt:
Zonder alles bestudeerd te hebben

Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Target.Column = 4 And Target.Row > 1 Then
    If MsgBox("Opnieuw berekenen?", vbQuestion + vbYesNo, "Datum volgende controle") = vbYes Then
      Target = Target.Offset(, 1)
      Sheets("Historie").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, UsedRange.Columns.Count) = Target.Offset(, -3).Resize(, UsedRange.Columns.Count).Value
    End If
    Cancel = True
  End If
End Sub
 
Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Target.Column = 4 And Target.Row > 1 Then
    If MsgBox("Opnieuw berekenen?", vbQuestion + vbYesNo, "Datum volgende controle") = vbYes Then
      Target = Target.Offset(, 1)
      with Sheets("Historie").Cells(Rows.Count, 1).End(xlUp)
        .Offset(1).Resize(, UsedRange.Columns.Count) = Target.Offset(, -3).Resize(, UsedRange.Columns.Count).Value
        .offset(1,5) = date
      end with
    End If
    Cancel = True
  End If
End Sub
 
Goedemorgen Harry,

Na een druk weekend heb ik de code vanmorgen even geprobeerd.
Hij maakt nu idd geen log meer als je nee invult op de vraag. En hij logt hem netjes onder de datum van vandaag als je wel ja invult.

Kortom, hij werkt helemaal zoals ik hem wil hebben. Bedankt!

vriendelijke groet,

Wiljen
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan