Gegevens kopiëren naar andere werkblad

[Erc]

Hallo

Ik heb 2 werkbladen in mijn document en werkte daarin met macro’s. Het tweede werkblad heb ik nu aangepast waardoor mijn code niet meer werkt.
Graag wil ik vanuit werkblad ‘producten’, artikels selecteren en kopiëren naar het werkblad ‘factuur’.

De artikels wil ik enkel door dubbelklikken in kolom H, kopiëren naar werkblad 'factuur', telkens naar de eerstvolgende lege rij van de tabel. Is dat mogelijk?

Als ik nu dubbelklik om wijzigingen aan te brengen in werkblad producten, krijg ik een foutmelding en moet altijd via de formulebalk iets wijzigen.




Iemand tips hoe ik mijn code moet aanpassen. Alle hulp is welkom.

Alvast bedankt!

Groeten
Ercan

 

[edmoor]

Doe het eens zo:

 

[Erc]

Hey

Werkt inderdaad prima zo, heel erg bedankt!

Er staat nu van mijn vorige werkblad nog wat code tussen. Welke code is voor dit document overbodig en kan ik best verwijderen? Indien nodig moet ik bij het eerste werkblad 'factuur' handmatig nog extra rijen kunnen toevoegen.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Column <> 8 Then Exit Sub
    Melding = MsgBox("Actie dubbel klikken OK.")
    rij = Sheets("Factuur").Cells(Cells.Rows.Count, 1).End(xlUp).Row 'Geeft de variabele "rij" de waarde van de laatst ingevulde rij (Row)
    rijplus = rij + 1 'is het nummer van de eerstvolgende LEGE rij
    
    If rij = 24 Then
        Melding = MsgBox("Er kunnen geen lijnen meer ingevoegd worden op de factuur.")
        Cancel = True
        Exit Sub
    End If
    
    tekopierenrij = ActiveCell.Row 'actuele rij opvragen op tabblad producten
        If tekopierenrij < 2 Or tekopierenrij > 100 Then
        Melding = MsgBox("Je selecteerde een verkeerde rij.")
        Cancel = True
        Exit Sub
    End If
    
    'For k = 2 To 100
    '    Sheets("factuur").Cells(rijplus, k - 12).Value = Sheets("producten").Cells(tekopierenrij, k).Value 'lus om gegeven te kopiëren)
    'Next
    Sheets("Factuur").Cells(rijplus, 1).Resize(, 6).Value = Sheets("producten").Cells(tekopierenrij, 1).Resize(, 6).Value
    
    rij = Sheets("Factuur").Cells(Cells.Rows.Count, 2).End(xlUp).Row 'Geeft de variabele "rij" de waarde van de laatst ingevulde rij (Row)
    overblijvende_rijen = 24 - rij
    'melding = MsgBox("Er zijn nog" & " " & overblijvende_rijen & " overblijvende_rijen over op de factuur.")
    Sheets("producten").Cells(12, 19).Value = overblijvende_rijen
    Cancel = True
End Sub

Alvast bedankt!

Groeten
Ercan

 

[edmoor]

Dit is voldoende:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Column <> 8 or Target.Row < 2 Then Exit Sub
    rij = Sheets("Factuur").Cells(Cells.Rows.Count, 1).End(xlUp).Row + 1
    Sheets("Factuur").Cells(rij, 1).Resize(, 6).Value = Sheets("producten").Cells(Target.Row, 1).Resize(, 6).Value
    Cancel = True
End Sub

 

[Erc]

Bedankt! :thumb: