Data automatisch sorteren en plakken in tabbladen

[Conejo]

Goedemorgen,

Het blad ''Mutaties'' gebruik ik om systeem gegenereerde data in te plakken. Het ultieme doel is dat na het plakken van deze data het automatisch gesorteerd en weergegeven word in andere tabbladen.

Regel met ''UIS'' in tabblad uitslag
Regel met ''INS'' in tabblad inslag
Regel met ''COR'' in correcties

Ben zelf al tijdje bezig geweest om dit met VBA voor elkaar te krijgen, helaas mocht dit niet lukken.

Mocht iemand kunnen helpen, dan hoor ik het graag.

Alvast bedankt!

 

[Cobbe]

Deze eenvoudige macro doet dat voor u:

Sub cobbe()
On error resume next
For Each cl In Range("C2:C" & Range("C" & Rows.Count).End(xlUp).Row)
 If cl = "INS" Then cl.Offset(, -2).Resize(, 7).Cut Sheets("Inslag").Range("A" & Sheets("Inslag").Range("A" & Sheets("Inslag").Rows.Count).End(xlUp).Row + 1)
 If cl = "UIS" Then cl.Offset(, -2).Resize(, 7).Cut Sheets("Uitslag").Range("A" & Sheets("Uitslag").Range("A" & Sheets("Uitslag").Rows.Count).End(xlUp).Row + 1)
 If cl = "COR" Then cl.Offset(, -2).Resize(, 7).Cut Sheets("Correcties").Range("A" & Sheets("Correcties").Range("A" & Sheets("Correcties").Rows.Count).End(xlUp).Row + 1)
Next
End Sub

 

[Cobbe]

Ik heb de code toch een beetje gefatsoeneerd:

Sub cobbe()
For Each cl In Range("C2:C" & Range("C" & Rows.Count).End(xlUp).Row)
 If cl = "INS" Then Blad = "Inslag"
 If cl = "UIS" Then Blad = "Uitslag"
 If cl = "COR" Then Blad = "Correcties"
   With Sheets(Blad)
    cl.Offset(, -2).Resize(, 7).Cut .Range("A" & .Range("A" & .Rows.Count).End(xlUp).Row + 1)
   End With
Next
End Sub

 

[Conejo]

Beste Cobbe,

Hartstikke bedankt voor je code. Deze dien ik gewoon in VBA venster te plakken?
Heb het geprobeerd, maar geeft geen reactie.

Excuus, heb VBA en de mogelijkheden nog maar net ontdekt.

Mvg.

 

[Warme bakkertje]

Of deze.

Sub verdeel_en_heers()
    With Sheets("Mutaties")
        For i = 1 To 3
            .Range("A1:G1").AutoFilter 3, Choose(i, "INS", "UIS", "COR")
            .AutoFilter.Range.Offset(1).SpecialCells(12).Copy Sheets(Choose(i, "Inslag", "Uitslag", "Correcties")) _
                        .Range("A" & Rows.Count).End(xlUp).Offset(1)
        Next
        .ShowAllData
    End With
End Sub

 

[Cobbe]

Je zou de macrocode moeten plakken in een module en dat doe je zo:
Via Alt-F11 kom jein de VBE (Visual Basic Editor)
Daar kan je via Invoegen kiezen voor oa Module, als je dat doet kan je rechts in het open venster deze code plakken.
Dan sluit je deze VBE en kom je terug in je werkblad.
Daar kies je in de tab Ontwikkelaars voor Invoegen en kies je button(getekende button).
Je tekent nu een button op je werkblad en klikt daarna rechts op deze button en je krijgt de keuze om een macro toe te wijzen , daar kies je idg. voor cobbe en klaar is .......

 

[Conejo]

Harstikke bedankt Cobbe en Rudi, super de macro werkt helemaal.
Enige probleem wat ik nu krijg (sorry) is het feit de gegevens in ''Uitslag'' niet gebruikt kunnen worden in een formule. Ik krijg de foutmelding: #VERW!

Nogmaals bedankt! :thumb:

 

[Cobbe]

Ik veronderstel dat het gaat over de aantallen in kolom G, dan kan je de code lichtjes aanpassen:

Sub cobbe()
For Each cl In Range("C2:C" & Range("C" & Rows.Count).End(xlUp).Row)
 If cl = "INS" Then Blad = "Inslag"
 If cl = "UIS" Then Blad = "Uitslag"
 If cl = "COR" Then Blad = "Correcties"
   With Sheets(Blad)
    cl.Offset(, -2).Resize(, 7).Cut .Range("A" & .Range("A" & .Rows.Count).End(xlUp).Row + 1)
    .Cells(.Range("A" & .Rows.Count).End(xlUp).Row + 1, "G") = .Cells(.Range("A" & .Rows.Count).End(xlUp).Row + 1, "G") * 1
   End With
Next
End Sub

Laat anders die formule eens zien met de vermelding waar die #VERW moet voor staan.

 

[Conejo]

Beste Cobbe,

Helaas lost dit het probleem niet op, gebruik zowel Artikelnummer, Aantal en Opdrachtgever in een formule. Deze formule o.a. VERT.ZOEK. haalt deze data weer uit een ander bestand. Normaliter, wanneer ik de data knip en plak verkreeg ik geen foutmelding.

Mvg.

 

[Cobbe]

Natuurlijk al je de gegevens verplaatst dan kloppen de verwijzingen ook niet meer en dien je de bereiken aan te passen.
Wij kunnen zonder voorbeeld niet inschatten wat de gevolgen zijn van een of andere actie.
Kan je geen voorbeeld posten (met dummy gegevens)?

Anders moet je dit eens aanpassen dan blijven de gegevens staan op blad "Mutaties" en worden ze enkel gekopiëerd naar afzonderlijke bladen:

cl.Offset(, -2).Resize(, 7).[COLOR="#FF0000"][/COLOR][B]COPY[/B] .Range

 

[Conejo]

Geweldig! Ontzettend bedankt scheelt mij een hoop knip en plak werk!

Vind het razend interessant en ben zelf ook aan de slag gegaan, loop alleen tegen het volgende probleem aan:

Sub verdelen()
For Each cl In Range("E2:E" & Range("E" & Rows.Count).End(xlUp).Row)
 If cl = "MAN" Then Blad = "Manco"
 If cl = "SURPLUS" Then Blad = "Surplus"
 If cl = "BREUK" Then Blad = "Breuk"
   With Sheets(Blad)
    cl.Offset(, -2).Resize(, 14).Copy .Range("A" & .Range("A" & .Rows.Count).End(xlUp).Row + 1)
End With
Next
End Sub

 

[Cobbe]

En wat is nu je probleem?
Kolom E is leeg dus zonder gegevens werkt het sowieso niet.
Als de werkbladen niet bestaan kun je er ook niet naartoe schrijven.

 cl.Offset(, -4).Resize(, 7).Copy

Offset(,-4) geeft Vanuit kolom E --> kolom A
Resise(,7) geeft vanuit kolo A ---> kolom G

 

[Conejo]

Excuses, heb het verkeerde bestand bijgevoegd.

Bekijk bijlage Data.xlsx

 

[Cobbe]

Je zal de code toch eens moeten proberen te doorgronden anders ga je er niet komen.
Wat is eigenlijk de bedoeling? Naar wat zoek je en naar waar moet het geschreven worden?
Moet het blad uit kolom E gehaald worden?
Anders moet je deze eens testen:

Sub verdelen()
On Error Resume Next
For Each cl In Range("E2:E" & Range("E" & Rows.Count).End(xlUp).Row)
 If InStr(UCase(cl), "MANCO") > 0 Then Blad = "Manco"
 If InStr(UCase(cl), "SURPLUS") > 0 Then Blad = "Surplus"
 If InStr(UCase(cl), "BREUK") > 0 Then Blad = "Breuk"
   With Sheets(Blad)
    cl.Offset(, -2).Resize(, 14).Copy .Range("A" & .Range("A" & .Rows.Count).End(xlUp).Row + 1)
   End With
   Blad = ""
Next
End Sub

 

[Conejo]

Inderdaad, een cursus op het gebied van VBA zou zeker niet kwaad kunnen. Hoop hier ook snel aan te beginnen.

Wat ik probeerde te bereiken is dat de macro selecteert op de omschrijving in kolom E en deze vervolgens overschrijft naar de daarvoor bestemde sheets.

BREUK 07-01-2014 ---> ''Breuk''

De reden dat ik maar drie regels had geschreven, is omdat alleen breuk, surplus en manco belangrijk zijn voor mijn data.

Omdat de opdracht lijkt op het vorige vraagstuk wat ik had, dacht ik aardig in de richting zat met mijn code. Helaas bleek het toch meer complex.

 

[Cobbe]

Zie post #14, die macro doet dat voor u.

 

[Warme bakkertje]

Sub verdeel_en_heers()
    With Sheets("Mutaties")
        For i = 1 To 3
            .Range("A1:G1").AutoFilter 5, "=*" & Choose(i, "MANCO", "SURPLUS", "BREUK") & "*"
            .AutoFilter.Range.Offset(1).SpecialCells(12).Copy Sheets(Choose(i, "Manco", "Surplus", "Breuk")) _
                        .Range("A" & Rows.Count).End(xlUp).Offset(1)
        Next
        .ShowAllData
    End With
End Sub

 

[Conejo]

Hartelijk dank voor al uw antwoorden. Macro's doen het naar behoren!

 

[Conejo]

Versnellen macro

Beste Warme Bakkertje,

Het originele Excel bestand is nu uitgebreid en word gebruikt voor veel data waardoor de macro heel traag is geworden.
2000 regels ongeveer.

Weet u een manier om deze macro te versnellen?

Sub verdelen()
For Each cl In Range("C2:C" & Range("C" & Rows.Count).End(xlUp).Row)
 If cl = "INS" Then Blad = "Inslag"
 If cl = "UIS" Then Blad = "Uitslag"
 If cl = "COR" Then Blad = "Breuk"
   With Sheets(Blad)
    cl.Offset(, -2).Resize(, 14).Copy .Range("A" & .Range("A" & .Rows.Count).End(xlUp).Row + 1)
End With
Next
End Sub

Met vriendelijke groet,

Conejo

 

[Cobbe]

Rudi het is voor u.