vba voor knippen en plakken van data mits criterium

[michelleblanc]

Hallo,

Ik probeer vba script te schrijven om data in tab "ontvangblad" te knippen/plakken in tab "overzicht".
Dit dient te gebeuren volgens volgende criterium: voor elke range A:CJ in tab "ontvangblad" (telkens 1 rij) moet cell A opgezocht worden in tab "overzicht" in colom A en dient dan de range A:CJ geplakt te worden in range H:CQ Bekijk bijlage nacalculs filter.xlsmals beide getallen in colom A van beide tabs identiek zijn.
Dit door middel van de knop "update" in tab "overzicht".

Bijgevoegd de excel file.
De file bevat links naar externe files, maar vormt geen probleem.

Dank alvast voor uw bereidwillige medewerking.
Michel

 

[edmoor]

Probeer dit maar eens achter die knop:

Sub Update()
    With Sheets("Ontvangblad")
        For i = 4 To .Range("A4").CurrentRegion.Rows.Count + 2
            Set fnd = Sheets("overzicht").Range("A1:A15000").Find(.Cells(i, 1), , , xlWhole, xlByRows)
            If Not fnd Is Nothing Then
                Cells(fnd.Row, 8).Resize(, 95) = .Cells(i, 1).Resize(, 88).Value
            End If
        Next i
    End With
End Sub

 

[VenA]

Hoeveel vragen ga je stellen over hetzelfde? https://www.helpmij.nl/forum/showthread.php/941608-vba-om-data-te-sorteren-van-ene-sheet-in-andere

 

[michelleblanc]

Dag Edmoor,

Ik heb uw code geprobeerd... zonder rezultaat.


Dag VenA,

Ik probeer zo snel mogelijk rezultaat te bekomen, vandaar 2 posts.
Ik wil dit oplossen met VBA, niet met vlookup.
Bedankt voor uw reacties.

Michel

 

[edmoor]

Hier werkt het anders prima in je eigen document.
De opmerking "zonder resultaat" heeft niemand wat aan.

 

[michelleblanc]

Na drukken op de knop, zie ik in tab "overzicht" in bijvoorbeeld inrij 950 niets verschijnen.


De excel die ik op forum geupload heb, heb ik leeg gemaakt want bevat vetrouwelijke info en misschien heb je wel de originele file nodig.

Indien OK voor u, stuur ik hem door via uw email adres, als je mij deze kan doorgeven?

Dank alvast voor de help.

Michel

 

[edmoor]

Voor de leesbaarheid wat aangepast, wellicht dat het verschil maakt in je eigen situatie.
Probeer het eens:

Sub Update()
    With Sheets("ontvangblad")
        For i = 4 To .Range("A4").CurrentRegion.Rows.Count + 2
            Set fnd = Sheets("overzicht").Range("A1:A15000").Find(What:=.Cells(i, 1), After:=Range("A3"), LookIn:=xlValues, _
                      LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
            If Not fnd Is Nothing Then
                Sheets("overzicht").Cells(fnd.Row, 8).Resize(, 95).Value = .Cells(i, 1).Resize(, 88).Value
            End If
        Next i
    End With
End Sub

 

[michelleblanc]

Nu krijg ik een run-time error 13 type mismatch...

Michel

 

[VenA]

Ik probeer zo snel mogelijk rezultaat te bekomen, vandaar 2 posts.

Lees even de forumregels.

 

[edmoor]

Wat ik al zei, hier werkt het in het document dat je plaatste prima.
Krijg je de fout in dat document of in je originele document?
In het laatste geval zal je zelf moet uitzoeken waar dat vandaan komt.

 

[michelleblanc]

Dag Edmoor,

Ik heb uw code in de lege excel geplaatst en de code werkt perfect.
Ik zoek uit wat probleem is in originele file.

Bedankt voor de moeite!

Michel

 

[michelleblanc]

Goeie avond edmoor,

U wcode werkt perfect.Fout zat hem in de i = 4 To .Range("A4").CurrentRegion.Rows.Count + 2. Dat heb ik aangepast naar i=2 To .Range("A2") enz...

Dank voor uw medewerking en prettige avond verder.

Michel

 

[edmoor]

Graag gedaan en goed werk van jezelf
Ook nog een fijne avond verder.

 

[edmoor]

Markeer je beide vragen hierover ook nog even als Opgelost.