Macro voor zoeken en kopiëren

[Danielle22]

Hallo,

Kan iemand mij helpen met een probleempje. Ik heb hier een lijst en die moet eigenlijk gefilterd worden. Op Blad 1 staan allemaal gegevens en als het resultaat FOUT is (zie voorbeeld) dan moeten die gegeven eigenlijk naar Blad2 gekopieerd worden.

Ik heb even een klein voorbeeldje bijgevoegd. Ik heb hier zelf de gegevens naar Blad2 gekopieerd, maar kan dat ook met een macro? Want normaal staan er wel 4000 gegevens in een blad.

Alvast heel erg bedankt voor de reacties

Groetjes,

Danielle

 

[Marrosi]

Goede middag Danielle,

Probeer iets in de zin van:

Sub Kopieer()
Dim x As Double
x = 8
Sheets("Blad1").Activate
Do Until Cells(x, 2) = ""
'Cells(x, 2).Activate
If Cells(x, 2) = "FOUT" Then
Cells(x, 2).CurrentRegion.Copy Destination:=Sheets("Blad2").Range("A65536").End(xlUp).Offset(2, 0)
End If
x = x + 10
Loop
End Sub

Ik heb dit vlug-vlug getypt evenwel zonder te testen.

MVG - Marrosi

 

[Danielle22]

Hallo Marrosi,

Heel erg bedankt voor je hulp. Dit ziet er erg goed uit! :thumb:

Groetjes,

Danielle

 

[Wigi]

Ik ga voor de Find methode:

Sub kopieren()
    Dim c As Range
    Dim firstAddress As String
    
    Application.ScreenUpdating = False
    Set c = Sheets("Blad1").Columns(2).Find("FOUT", LookIn:=xlValues, lookat:=xlWhole)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            c.CurrentRegion.Copy Sheets("Blad2").Range("A" & Rows.Count).End(xlUp).Offset(2)
            Set c = Sheets("Blad1").Columns(2).FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
    Application.ScreenUpdating = True

End Sub

Wigi

 

[Danielle22]

Hallo Wigi,

Oke ik ga die van jou ook even in mijn schema zetten, bedankt!. Wat is het verschil precies tussen beide macro's?

Groetjes,

Danielle

 

[Wigi]

Ik vermoed dat die van mij veel sneller klaar zal zijn, zeker bij duizenden rijen.

Voor de aardigheid, neem de proef maar eens op de som om te zien welke het snelste is.

 

[Barracuda2805]

Hoi Wigi,

dit is een hele mooie oplossing.
Wat voor mij niet duidelijk is hoe er nu bepaald is welke velden er geselcteerd worden om te kopieren naar blad2, zou je dit willen uitleggen?

Wat ik mij afvraag of dit ook mogelijk is wanneer alle data op 1 regel staat in plaats van over meerdere regels.

Document	Uitgevoerd	Koppeling	Dag	Tarief	Totaal	ZP	Resultaat        :	Doorloop
1	proeftekst		Maandag	23	25	4545	Goed	2
2	proeftekst		Dinsdag	23	25	2365	Fout	6
3	proeftekst		Woensdag	23	25	6522	Goed 	4
4	proeftekst		Donderdag	23	25	6532	Fout	8

Zou je hiervoor ook een voorbeeld willen geven?

Alvast bedankt voor de uitleg.

Gr. Barracuda

 

[Wigi]

Hoi Wigi,

dit is een hele mooie oplossing.
Wat voor mij niet duidelijk is hoe er nu bepaald is welke velden er geselcteerd worden om te kopieren naar blad2, zou je dit willen uitleggen?

c is de cel waarin FOUT gevonden wordt.

c.CurrentRegion is een rechthoekig cellenbereik, rondom de cel "c", omringd door lege cellen. Dat wordt vervolgens gekopieerd.

 

[Wigi]

Wat ik mij afvraag of dit ook mogelijk is wanneer alle data op 1 regel staat in plaats van over meerdere regels.

Document	Uitgevoerd	Koppeling	Dag	Tarief	Totaal	ZP	Resultaat        :	Doorloop
1	proeftekst		Maandag	23	25	4545	Goed	2
2	proeftekst		Dinsdag	23	25	2365	Fout	6
3	proeftekst		Woensdag	23	25	6522	Goed 	4
4	proeftekst		Donderdag	23	25	6532	Fout	8

Zou je hiervoor ook een voorbeeld willen geven?

Verander de 2 in

Columns(2)

in het juiste kolomnummer waarin gezocht moet worden. Dit komt wel 2 keer voor in de code.

Het kopiëren zal dan zoiets worden:

c.[B]EntireRow[/B].Copy Sheets("Blad2").Range("A" & Rows.Count).End(xlUp).Offset(2)

Wigi

 

[Barracuda2805]

Hoi Wigi,

kan ik in plaats van "entirerow" ook aangeven dat ik enkel de waarde in kolom a,b,f en I in de betreffende regel wil kopieren?

Gr. Barracuda

 

[Wigi]

Doe

Range("A" & c.Row, "L" & c.row).SpecialCells(xlCellTypeVisible).Copy Sheets("Blad2").Range("A" & Rows.Count).End(xlUp).Offset(2)

waarbij je eerst de overige kolommen (c, d, e, g, ...) verborgen hebt. Al dan niet via code. Daarna kolommen terug zichtbaar maken.

Wigi

 

[Wigi]

Zeg, maar als alles mooi onder elkaar staat, is een Autofilter véél beter. En moet je een lus vermijden. Kopieer dan de rijen die de Autofilter vindt (dus die met FOUT erin).

Wigi

 

[Barracuda2805]

Wigi,

met hide optie werkt dit perfect.

Zelf dacht ik aan : select Document, dag, totaal , doorloop where Resultaat is "Fout".
Een benadering vanuit sql maar weet niet of dit mogelijk is.

Zover mijn kennis rijkt zou dit toch mogelijk kunnen zijn als je in een array je kolomheaders opneemt?

Gr. Barracuda

 

[Wigi]

Zie voor code hier.

 

[Barracuda2805]

Zie voor code hier.

Thanks Wigi,

je hebt mij een heel eind op weg geholpen, ga zelf verder puzelen en laat je weten wat het resultaat geworden is.

nogmaals bedankt,

Gr. Barracuda