Meerdere keren verticaal zoeken of VBA

[Ricedam]

Goedemiddag,
Ik loop tegen het volgende probleem op.
In bijgevoegd test document:
Als er in B2 de text Type 1 komt te staan en er in C2 de text In-Proces zou ik vanuit het tabblad Type 1 alle regels waar in kolom D In-proces staat op blad 1 onder elkaar willen laten verschijnen. Nu heb ik dat al zo neergezet vanaf kolom A7.
Als er echter in B2 Type 1 staat en in C2 Uit-proces wil ik alle regels uit het tabblad type 1 waar in kolom D de text uit-proces staat.
Als er nu in B2 Type 2 staat moet hij alle gegevens zoals hierboven beschreven uit tabblad type 2 halen.

Ik hoop dat ik het hier duidelijk heb omschreven. Kan dit met verticaal zoeken of is hier VBA de beste oplossing.

Is er iemand die mij hiermee kan helpen,

 

[Conseclusie]

Met VBA:

Sub Test()
Rows("6:1000").ClearContents
RijBlad1 = 6
With Sheets(Range("B2").Value)
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
For Rij = 2 To LastRow
    If Sheets(Range("B2").Value).Cells(Rij, 4).Value = Range("C2").Value Then
        For Kolom = 1 To 5
            Cells(RijBlad1, Kolom).Value = Sheets(Range("B2").Value).Cells(Rij, Kolom).Value
        Next Kolom
        RijBlad1 = RijBlad1 + 1
    End If
Next Rij
End Sub

NB: "In-proces" staat zonder hoofdletter P in je type-tabs.

 

[Ricedam]

Beste Conseclusie,

Ik heb de VBA ingevoegd maar bij mij werkt hij nog niet. Zou jij voor mij het bestandje met bijgewerkte VBA kunnen bijvoegen? Ik doe vast iets niet goed (nog een junior VBA gebruiker )

 

[Conseclusie]

Natuurlijk...

 

[HSV]

Waarom niet uitvoeren als cel B2 veranderd.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Address(0, 0) = "B2" And Target.Offset(, 1) <> "" Then
 Range("a6", Cells(Rows.Count, 1).End(xlUp)).Resize(, 5).ClearContents
    With Sheets(Target.Value).Cells(1).CurrentRegion
     .AutoFilter 4, Target.Offset(, 1)
     .Offset(1).Copy Sheets("blad1").Cells(6, 1)
     .AutoFilter
    End With
 End If
 Application.EnableEvents = True
End Sub

 

[Ricedam]

Dank voor jullie meedenken. Het werkt bij mij niet zoals ik het bedoel. Ik heb een nieuw excel bestand meegestuurd en drie screenshots hoe het er uit zou moeten komen te zien als de cel B2 en C2 gevuld worden

 

[HSV]

Je weet waarschijnlijk niet waar je de code moet plaatsen en hoe het werkt.

 

[Ricedam]

Hallo Harry,

Ik heb een module ingevoegd en daar de code ingezet. Wat ik al aangaf ik ben geen VBA goeroe. Maar wat ik graag wil is met de normale formules niet echt mogelijk. Als jij het wel snapt hoop ik dat je me wilt helpen.

Met vriendelijke groet,
Richard

 

[emields]

Dat moet niet in een module maar onder een blad. Klik met rechts op de tab van het blad en kies daar programma code en plak het daar

 

[emields]

of doe het zo

 

[HSV]

Nog een ander snellere methode dan cel voor cel doorlopen.

Sub hsv()
 Range("c1") = "Proces"
 Range("a6", Cells(Rows.Count, 1).End(xlUp)).Resize(, 5).ClearContents
    With Sheets(Range("b2").Value).Cells(1).CurrentRegion
      .Cells(1).CurrentRegion.AdvancedFilter 2, Range("c1:c2"), Range("a6")
    End With
End Sub

 

[Ricedam]

Dank allen. Ik ben een heel eind verder gekomen. Nog niet helemaal af maar mocht ik nog vragen hebben kom ik weer in de lucht.