Gezocht een selectie met vba

Goedenavond

Ik zoek een vba code waarmee ik het volgende kan oplossen:

In blad 'plak215' staan bepaalde gegevens met een “1” die ik in het blad 'gew' gerangschikt wil hebben.
De sleutel is wdod in kolom B van plak 215.

Wanneer ik in blad 'GEW'A1 ” 5” typ, moet er een selectie plaats vinden in plak 215 . ( of een ander getal uiteraard)


1.De rijen in Plak 215 met in kolom B met een 5 of hoger in kolom b zijn rijen die voldoen.
2.Vervolgens moet in die rijen waar een 1 staat het bijbehorende nummer (kolom c) geplaatst worden bij de bijbehorende categorie in "gew"
3.Tot slot moet er naast dat nummer ook weer het bijbehorende. wdod komen

IK lees hier wel eens dat een duidelijke vraag, een kwart van het antwoord is.


"Eén bestand zegt meer dan duizend woorden.."

Ik hoop dat iemand zo vriendelijk is om mij te helpen

Bekijk bijlage voorbeeld.xlsx

Misschien helpt dit jou een stukje verder

Goedemorgen en hartelijk dank voor uw reactie.

Hij doet het nu alleen voor kolom B.
Het is de bedoeling dat alle cellen in plak 215 met een 1 naar "gew" gaan met daarvoor hun "WDOD" zoals nu ook correct met kolom b gebeurt.

Ik had al script dat werkte maar deze werkte van in plak215 kolom j tot en met b
Ik wil nu dat deze voor het hele blad plak 215 werkt.
Heb dat script als plaatje bijgevoegd

Bij voorbaat hartelijk dank

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [a1]) Is Nothing Then
vanaf = Application.WorksheetFunction.Sum([a1])
Application.ScreenUpdating = False
Application.EnableEvents = False
[c2:an65000].ClearContents
For Each comp In Sheets("plak215").Range(Sheets("plak215").[b3], Sheets("plak215").[b500000].End(xlUp))
If Application.WorksheetFunction.Sum(comp) >= vanaf Then
If Application.WorksheetFunction.Sum(Sheets("plak215").Range(comp.Offset(0, 8), comp.Offset(0, 27))) > 0 Then
For i = 0 To 19
If Application.WorksheetFunction.Sum(comp.Offset(0, 8 + i)) > 0 Then

monster = comp.Offset(0, 1).Value
Set doelcel = Cells(200000, 3 + 2 * i).End(xlUp).Offset(1)
doelcel.Value = comp.Value
doelcel.Offset(0, 1).Value = monster
End If
Next i
End If
End If

Next comp

Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub

Nu met 51 kolommen

Hallo Wampier.

Nogmaals bedankt voor uw tijd en moeite.:thumb:

Ik doe er een duidelijker voorbeeld bij, omdat zoiets uitleggen erg lastig is.
Diegene die ik toevoeg voldoet bijna, hij moet alleen in plak215 kolom "i" beginnen.( begint nu in "j")
Ik hoop dat u nog een keer wil kijken naar het bijgevoegde bestand.

( ik verander uiteraard de koppen in de nieuwe versie)

Vriendelijk groeten Henk Harbers

Bekijk bijlage hmzb.xlsm