cell.entirerow.copy, maar dan niet de hele rij

[wroefkes]

Na uitstekende ervaringen bij mijn eerste hulpvraag, probeer ik het nogmaals voor iets waar ik na lang speuren toch (weer) niet uit kan komen.

Ik heb 2 werkbladen, met nagenoeg dezelfde kolommen. In het eerste werkblad staat alleen een kolom extra ("E") waarin aangegeven moet worden of iemand meegenomen moet worden voor een startwerkbespreking. Als alles is ingevuld moeten alle rijen waarin in kolom E 'ja' is ingevuld, gekopieerd worden naar het volgende werkblad. Alleen exclusief kolom E (of de betreffende cel of waarde in die cel)! In het tweede werkblad ontbreekt deze kolom met deze vraag namelijk.

De printscreens zijn bijgevoegd.

Onderstaande code heb ik gevonden:


Sub CopyRowInputItem()
Dim r As Integer
Dim cell As Range
r = 11
Application.ScreenUpdating = False
For Each cell In Worksheets("Personen op bouwlocatie").Range("E11:E30").Cells
If cell.Value = "ja" Then
cell.EntireRow.Copy
Sheets("Startwerkbespreking").Cells(r, 1).EntireRow.PasteSpecial xlPasteValues, SkipBlanks:=True
r = r + 1
End If
Next cell
Application.ScreenUpdating = True
End Sub


Alleen ipv cell.entirerow.copy, wil ik dus een rij kopiëren uit werkblad 1 exclusief de waarde "ja" uit kolom E. Kan iemand mij helpen de code aan te passen?

 

[VenA]

Moet dit in een Word document gebeuren?

 

[SjonR]

tja, het is in ieder geval een voorbeelddocument....

maar hoe dan ook, een excelbestand plaatsen lijkt me beter!

 

[wroefkes]

Ja, jullie hebben gelijk... Heb ik in eerste instantie niet gedaan omwille van privacy, maar hierbij dan toch...

 

[VenA]

Aan bestanden waar nagenoeg niets in staan hebben we niet veel. Om een kolom over te slaan kan je een Union gebruiken. ipv alles cel voor cel te doen kan je beter het autofilter gebruiken. Waarom is E40 in het blad 'Personen op bouwlocatie' leeg?

Voorbeeldje van code met een union

Sub VenA()
  With Sheets("Personen op bouwlocatie").Cells(10, 1).CurrentRegion
    .AutoFilter 5, "Ja"
    Union(.Columns(1).Offset(1).Resize(, 4), .Columns(6).Offset(1).Resize(, 5)).Copy Sheets("Startwerkbespreking").Cells(11, 1)
  End With
End Sub

 

[wroefkes]

Dank voor jouw reactie VenA. Het bestand is nagenoeg leeg, omdat het eenvoudigweg nog niet is gebruikt . Het is een concept.
Waarom E 40 leeg is dat weet ik niet. Waarschijnlijk verkeerd gegaan bij het opnieuw opslaan oid. Het is ook voor de code niet van belang.

Ik zal bovenstaande eens proberen en mijn ervaring posten. Tnx in ieder geval!

 

[wroefkes]

Ik heb de code getest en hij werkt! Het gaat mij de pet te boven, maar ik ben wel geholpen In mijn VBA beginners boeken kom ik dergelijke code niet tegen... ik loop te ver achter ben ik bang :shocked:

Bedankt VenA weer voor jou inbreng. En wie weet tot de volgende keer.

 

[VenA]

Lege cellen in kolomkoppen zijn wel degelijk van belang voor de code als je een eenduidige code wil maken voor meerdere bereiken. Selecteer A10 en druk op <Ctrl> + a je krijgt dan de CurrentRegion doe hetzelfde in A40 en zoek de verschillen. Als het nog een concept is dan kan je beter eens nadenken of het niet handiger is om alles in 1 gestructureerde tabel te zetten ipv vanuit de opmaak te denken.

 

[wroefkes]

Ik begrijp dat lege cellen er wel degelijk toe doen. In de uiteindelijke versie zal E40 weer netjes gevuld zijn met dezelfde tekst als E10. Of misschien laat ik het duplicaat vanaf A36 wel helemaal weg. Er was in ieder geval gewoon een foutje in geslopen.

Work in progress... Nogmaals dank voor jouw inbreng VenA. Top.