Cellen kopiëren indien voldaan voorwaarde "ja/nee"

Status
Niet open voor verdere reacties.

ShouldersUp

Nieuwe gebruiker
Lid geworden
20 jan 2021
Berichten
4
Beste,

Ik ben al enige tijd aan het "prutsen" met VBA-code, maar val nu stil. Tijdens mijn onderzoek op deze pagina naar een antwoord kwam ik oplossingen tegen die in de buurt kwamen voor mijn probleem, maar helaas niet geheel passend. Door mijn gebrek aan VBA kennis lukt het me niet om enkele codes samen te voegen tot het gewenste resultaat

Ik wil graag dat de waardes X, Y en Z worden verplaatst naar tablad extra OP VOORWAARDE dat de cel in kolom 2 'Ja' aangeeft. Bij 'nee' of lege cellen worden de waardes niet gekopieerd. Op dit moment worden de waardes te allen tijde gekopieerd ongeacht de voorwaarde. Ik hoop dat iemand mij kan helpen :)

Ik heb een voorbeeld bijgevoegd om mijn probleem te duiden.
 

Bijlagen

  • kolommen kopieren.xlsb
    27,2 KB · Weergaven: 19
Probeer dit eens:
Code:
            For j = 2 To UBound(ar)
                If LCase(ar(j, 2)) = "ja" Then
                    ar1(t, 1) = ar(j, 1)
                    ar1(t, 4) = ar(j, 3)
                    ar1(t, 6) = ar(j, 4)
                    t = t + 1
                End If
            Next j
 
Toch nog een aanvullende vraag.

Het document was een simpel voorbeeld en heb de code vervolgens overgenomen in een ander document. Nu valt de code stil bij:
Code:
ReDim ar1(UBound(ar), 6)

Volgens mij zit de fout hem in de 6, als verwijzingsgebied. Maar ik kan de code onvoldoende goed lezen. Kan iemand me helpen? Wellicht is er ook een simpelere code voor mijn probleem?
 

Bijlagen

  • Map1.xlsm
    26,5 KB · Weergaven: 19
gaat hier fout

Code:
ar = .Cells(6).CurrentRegion
 
Code:
Private Sub CommandButton1_Click()
   With Blad1.ListObjects(1).DataBodyRange
      .AutoFilter 2, "Ja"
      Set y = Blad2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 1)
      .Columns(1).Copy y
      .Columns(3).Copy y.Offset(, 3)
      .Columns(4).Copy y.Offset(, 5)
      .AutoFilter
   End With
End Sub
 
Die van snb werkt perfect in het document dat je in #1 plaatste.
Je document in #4 is ineens heel anders en gaat het uiteraard niet zonder aanpassingen in de code.
 
.Cells heeft een rij- en kolomgetal nodig. De enige uitzondering hierop is .Cells(1,1) dit mag je schrijven als .Cells(1). Als je toch een tabel gebruikt dan kan je beter direct naar de tabel verwijzen zoals in #6 staat.
 
Code:
Sub M_snb()
  With [Tabel2]
    .AutoFilter 5, "Ja"
    .Columns(1).Resize(, 2).Copy [Tabel1].Cells(1).End(xlDown)
    .AutoFilter
  End With
End Sub

Begin iedere tabel in cel A1.
Verwijder lege, overbodige rijen.
 
cells(6) is gewoon ??

Code:
for i = 1 to 10
 cells(i).select
next i
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan