verplaatsen

[broek76]

goedemorgen,

Ik ben een nieuw bestelbestand aan het maken en nu loop ik tegen het volgende aan:
blad1 is een grondstoffenlijst en op blad2 moeten de grondstoffen komen staan die ik wil bestellen.
Hoe kan ik er voor zorgen dat alleen de grondstoffen waar ik iets bij invul op blad2 terecht komen(zonder allemaal lege rijen er tussen)?

Alvast bedankt

 

[spaarie]

Gisteren nog een matrixformule voor geplaatst..
http://www.helpmij.nl/forum/showthread.php/772206-Formule-vergelijken

En met een macro/module:

Sub Spaarie()
    With Sheets(1)
        For Each v In .Range("B2:B" & .Range("A" & Rows.Count).End(xlUp).Row) 'pas de kolomletters aan, let wel dat de laatste letter een kolom is die tot einde bestand gevuld is
            If v <> "" Then
                v.Copy Sheets(2).Range("B" & Rows.Count).End(xlUp).Offset(1) 'pas de kolomletter aan
            End If
        Next
    End With
End Sub

 

[broek76]

Het gaat toch niet helemaal goed, het lijkt er op dat hij niet alle getallen pakt.
Ik zal er even een voorbeld bij doen van wat ik tot nu toe heb.

Nu staan er ook alleen getallen op blad2 zonder de bijbehorende boodschappen, is er ook een formule die de boodschappen er bij zet?
En, als laatste, kan hij ze ook van de goede week pakken?

Mvg Ron

 

[spaarie]

Altijd handig zo'n voorbeeldbestand, dan zijn die nutteloze posts zoals #2 niet nodig...
Kies op blad2 je weeknummer en voila!

 

[broek76]

Nou niet helemaal nutteloos, voor mij tenminste niet.
Ik ben geen ster in VBA en weet nu dus ook niet precies hoe je het gedaan hebt. Dat maakt het erg lastig om het ook in andere bestanden toe te passen omdat ik eerst uit moet zoeken welke regel nou precies waar voor zorgt.
Het werkt overigens wel perfect in dit bestand, hartelijk dank.

 

[spaarie]

De code met onder de regels uitleg voor eventuele aanpassingen in de toekomst..

Private Sub Worksheet_Change(ByVal target As Range)
    If target.Address = "$B$2" Then
    'module gaat lopen wanneer deze cel wordt gewijzigd
        If target = "" Then
        'als de cel leeg is
            MsgBox "De cel is leeg"
            'melding geven cel is leeg
        Else
            With Sheets(1)
            kolom = Mid(.Range("B2:E2").Find(target).Address, 2, 1)
            'zoek de gewijzigde celwaarde op blad1 in B2:E2 en geef de letter van de kolom
            Sheets(2).Range("A4:B" & .Range("A" & Rows.Count).End(xlUp).Row).ClearContents
            'op blad 2 vanaf A4 tot laatste regel wissen
                For Each v In .Range(kolom & "3:" & kolom & .Range("A" & Rows.Count).End(xlUp).Row)
                'voor elke waarde in de gevonden kolom
                    If v > 0 Then
                    'als waarde groter is dan 0
                        v.Copy Sheets(2).Range("B" & Rows.Count).End(xlUp).Offset(1)
                        'kopieer waarde naar eerste lege cel in kolom B op blad 2
                        .Cells(v.Row, "A").Copy Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1)
                        'kopieer ook de waarde van kolom A naar blad 2
                    End If
                Next
            End With
        End If
    End If
End Sub

 

[broek76]

Aah, netjes. Erg fijn dat er mensen zijn die de wat minder begaafden een handje kunnen en vooral ook willen helpen.
Zo ga ik er zeker uitkomen, mijn dank is groot.