foutmelding Select van klasse range

[martijnbos]

Hoi allemaal,

Zit met een probleem in een sheet.
Een gebruiker kan op blad artikeldata een leverancier kiezen in cel b3.
Daarna wordt vanuit blad Data AX de artikelen van die leverancier overgehaald naar blad Artikeldata.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address <> "$B$3" Then Exit Sub

    Range("A15:Y1000").ClearContents 'schoonveeggebied
    Range("A15").Select 'startpunt

    Dim a As Double
    a = 2
    Do While Sheets("Data AX").Cells(a, 1) <> "" 'çontrole of blad data niet leeg is
    If Sheets("Data AX").Cells(a, 1) = Range("B3").Value Then 'kijken naar geselecteerde leveranciers overeenkomt, dus wel cel/kolom
    'ActiveCell = Sheets("Data AX").Cells(a, 1) 'wegschrijven zoekwaarde
    ActiveCell.Offset(0, 1) = Sheets("Data AX").Cells(a, 2) 'haal AX artikelnummer op/'voor =teken is plek waar data heen moet, achtter is teken plek ophalen
    ActiveCell.Offset(0, 2) = Sheets("Data AX").Cells(a, 3) 'haal artikel status op
    ActiveCell.Offset(0, 3) = Sheets("Data AX").Cells(a, 4) 'haal EAN code op
    ActiveCell.Offset(0, 4) = Sheets("Data AX").Cells(a, 5) 'haal artikelnummer leverancier op
    ActiveCell.Offset(0, 5) = Sheets("Data AX").Cells(a, 6) 'haal artikelomschrijving leverancier op
    ActiveCell.Offset(0, 6) = Sheets("Data AX").Cells(a, 7) 'haal artikelomschrijving Intratuin op
    ActiveCell.Offset(0, 7) = Sheets("Data AX").Cells(a, 8) 'haal VPE op
    ActiveCell.Offset(0, 8) = Sheets("Data AX").Cells(a, 9) 'haal CBM op
    ActiveCell.Offset(0, 9) = Sheets("Data AX").Cells(a, 10) 'haal #stuks 20FT op
    ActiveCell.Offset(0, 10) = Sheets("Data AX").Cells(a, 11) 'haal #stuks 40FT op
    ActiveCell.Offset(0, 11) = Sheets("Data AX").Cells(a, 12) 'haal #stuks 40FTHC op
    ActiveCell.Offset(0, 12) = Sheets("Data AX").Cells(a, 13) 'haal inkoopprijs op
    ActiveCell.Offset(0, 13) = Sheets("Data AX").Cells(a, 14) 'haal HS code op
    ActiveCell.Offset(1, 0).Select
End If
    a = a + 1
Loop
    Application.Goto Range("A1"), True
End Sub

Tot zover werkt de code prima

Nu wil ook graag dat een gebruiker een leverancier kan "vullen" d.m.v. een dubbelklik op een leverancier in blad leveranciers. Dat doe ik met deze code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.ScreenUpdating = False

  

    Sheets("Artikeldata").Range("B3") = Target
    Cancel = True
    Sheets("Artikeldata").Activate
Application.ScreenUpdating = True

End Sub

Maar na de dubbelklik gaat de code fout op:

 Range("A15").Select 'startpunt

Iemand enig idee wat ik fout doe en hoe je dit kan oplossen?
Zie bijlage met voorbeeld
Bekijk bijlage voorbeeldje.xlsm
Gr.
Martijn

 

[rebmog]

Je kunt volstaan met de volgende code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.ScreenUpdating = False
    Sheets("Artikeldata").Activate
    Sheets("Artikeldata").Range("B3") = Target
Application.ScreenUpdating = True
End Sub

De foutmelding treedt dan niet meer op.

Rebmog

 

[martijnbos]

super. Dank je wel. Dit werkt prima

Mijn dank is groot