Excel VBA macro om gegevens te rangschikken?

[dannieshelp]

Hallo,

Ik heb het volgende probleem. Ik heb de onderstaande code van het internet. Deze zoekt mijn sheets af naar alle prioriteit 1 projecten en plakt deze vervolgens in de sheet "Prioritylist". Nu wil ik hem zo aanpassen dat hij vervolgens alle prioriteit 2, 3 en 4 projecten ook opzoekt en alles netjes onder elkaar plakt. Kan iemand mij vertellen hoe ik dat kan doen? Ik heb al geprobeerd om teller 2 aan te passen met activecell, en nog wat aanpassingen maar ik ben niet zo handig in excel en blijf maar fouten krijgen.

De code is als volgt:

Sub MacroPriorityList()
Dim teller1, teller2 As Integer

teller2 = 6

Worksheets("Prioritylist").Select
Rows("3:50").Formula = ""
For teller1 = 1 To 4
If Worksheets(teller1).Name = "Prioritylist" Then
teller1 = teller1 + 1
End If
Worksheets(teller1).Select
Range("a6").Activate
While ActiveCell.Formula <> ""
If UCase(ActiveCell.Offset(0, 0).Formula) = "1" Then
Rows(ActiveCell.Row).Select
Selection.Copy
Worksheets("Prioritylist").Select
Range("a" & teller2).PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
teller2 = teller2 + 1
Worksheets(teller1).Select
Application.CutCopyMode = False
End If
ActiveCell.Offset(1, 0).Activate
Wend
Next
Worksheets("Prioritylist").Select
Range("a1").Select
End Sub

Alvast bedankt,

Groeten Danny

 

[snb]

Gebruik hiervoor autofilter.

 

[dannieshelp]

Autofilter?

Hoi,

Misschien een stomme vraag, maar hoe past autofilter in dit plaatje? Hoe moet ik die in de code verwerken?
De code die ik eerder heb vermeld zoekt alleen alle prioriteit 1 projecten op. Nu wil ik dat dat ook gebeurt voor de resterende prioriteiten (2,3 en 4), oftewel alles ongelijk aan "Complete". Ik heb al wat variaties geprobeerd, maar ik krijg het niet voor elkaar om alles netjes onder elkaar geplakt te krijgen.
Is er een makkelijke manier om deze code aan te passen?

Ik zal even een klein gedeelte van mijn excel bestandje erbij plakken. Het gaat dus om de data op de werkbladen "Formulation Active", "Market Conform Active" en "Differentiation Active". Hiervan moeten alle projecten onder elkaar op volgorde( van prioriteit 1 naar 4) op het werkblad "PriorityList" komen.

Op regel 5 van blad 1 verdwijnt ook telkens de tekst die op de blauwe balk hoort te staan wanneer ik de macro uitvoer, maar de reden waardoor weet ik ook nog niet. Dus als iemand dat mij ook zou kunnen vertellen?

Alvast bedankt,

Danny

 

[Wigi]

Op regel 5 van blad 1 verdwijnt ook telkens de tekst die op de blauwe balk hoort te staan wanneer ik de macro uitvoer, maar de reden waardoor weet ik ook nog niet. Dus als iemand dat mij ook zou kunnen vertellen?

Dit komt door:

Rows("3:50").Formula = ""

Als je op F8 drukt kan je stap voor stap door de code gaan en zien wat er (al dan niet) gebeurt.

 

[Wigi]

Sub MacroPriorityList()

    Dim teller2 As Long
    Dim ws As Worksheet
    Dim l As Long

    Application.ScreenUpdating = False
    
    teller2 = 6    'beginregel om naar toe te kopieren in totaalsheet

    Worksheets("Prioritylist").Rows(teller2 & ":50").ClearContents

    For Each ws In ThisWorkbook.Worksheets
    
        If ws.Name <> "Prioritylist" Then

            With ws
                
                For l = 6 To .Range("A" & Rows.Count).End(xlUp).Row
                
                    If .Range("A" & l).Value = 1 Then
                    
                        .Range("A" & l, "H" & l).Copy
                        Sheets("Prioritylist").Range("A" & teller2).PasteSpecial xlValues
                        teller2 = teller2 + 1
                        
                    End If
                
                Next
                
            End With
            
        End If
        
    Next
        
    With Application
    
        .CutCopyMode = False
        .Goto Sheets("Prioritylist").Range("a1"), True
        .ScreenUpdating = True
    
    End With
    
End Sub

Wigi

 

[dannieshelp]

Dit is al een stuk beter

Ha Wigi,

Ja, stom van die Rows("3:50").Formula = "", dat had ik moeten zien.

Deze code werkt al beter ja.
Het enige wat nu nog ontbreekt, is dat:
1)Hij vervolgens alle prioriteit 2 projecten eronder plakt, prioriteit 3 en als laatste 4. Moeten daar weer nieuwe macro's voor gemaakt worden of kan dat door deze macro (simpelweg?) aan te passen?

2)Hij hoeft alleen te zoeken in werkblad 2 t/m 4 (omdat ik bang bent wanneer de file groot wordt (er komen nog extra werkbladen bij), dat het zoeken te lang gaat duren. Of zal dat meevallen?). Hoe kan ik dat aanpassen? Ik heb al geprobeerd jouw code aan te passen, door ws integer te maken en dan "For WS 2 to 4" te schrijven, maar dan krijg ik jouw code niet goed aangepast. Ook heb ik geprobeerd om "Worksheets(Array("Blad2", "Blad3", "Blad4")).Select"te gebruiken maar dan loop ik ook vast.

Help?

Grt. Danny

 

[Wigi]

If .Range("A" & l).Value = 1 Or .Range("A" & l).Value = 2 Or .Range("A" & l).Value = 3 Or .Range("A" & l).Value = 4 Then

'code...

End If

En op het einde sorteer je het desgewenst.

Wigi

 

[dannieshelp]

Het is gelukt!

Ha Wigi,

Het is gelukt. Ik heb nog ff een autofilter in de code verwerkt en nu werkt alles naar behoren.

Bedankt.

Groeten,

Danny