VBA om cellen te kopieren

[NoVaX]

Hallo allemaal,

Ik ben aan het uitzoeken of ik een macro kan toepassen om cellen te kopieren van werkblad A met een voorwaarde naar werkblad (voorwaarde)

Zoals het bijgevoegde document
Kijk naar kolom D en zoek naar voorwaarde: Jaap
Kopieer de hele rij als aan voorwaarde: jaap wordt voldaan naar tabblad (Jaap)

En dat voor gebruikers Jaap, Jan, Dirk, Pablo, Ton, Remi

Ben al even aan het zoeken maar ik kom er niet uit, ik hoop dat iemand mij kan helpen.

dit bestand wordt gepubliceerd op een website, gesorteerd op hoeveel er nog van welke taak bij wie nog open staat. Dit is een formule die werkt op hetzelfde werkblad.
Echter willen vervolgens een overzicht uitdraaien wanneer we meer gegevens willen hebben. Als dat gesorteerd kan worden op de website, ben ik ook heel erg geholpen

Alvast bedankt,

Pablo

 

[mvw64]

Misschien kan je er zo iets mee ?

 

[NoVaX]

Beste Mvw64,

Hartelijk bedankt voor de moeite, maar waar ik elke keer op vast loop is op een worksheet die wordt geclassificeerd als Veryhidden. De data komt rechtstreeks uit het administratieprogramma, vandaar. Maar wanneer ik de gegevens naar jouw worksheet publiceer, komt het er wel uit. Is er een optie om deze worksheet buiten beschouwing te laten? De sheet heet AfasAdminSheet


Ook zit er in het document nog een tweede tabblad genaamd insite. Deze moet wel blijven bestaan. hier staat een overzicht op van de hoeveelheid taken geteld per taak per gebruiker.
Op deze tab wordt ook een hyperlink geplaatst als je op de naam van de gebruiker klikt dat je naar de worksheet gaat waar de taken van deze gebruiker staan.

Uiteindelijk wordt het document gepubliceerd als .htm en op een site gepubliceerd. Dit gebeurd al Via VBA.

Alvast hartelijk bedankt,
Ik hoop dat je er iets mee kan

 

[Warme bakkertje]

Sub ZetOver()
    Dim c, Blad, wb As Worksheet
    Application.ScreenUpdating = False
    With Sheets("Blad1")
        For Each c In .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
            If .Cells(c.Row, "D") = vbNullString Then GoTo Opnieuw
            Blad = .Cells(c.Row, "D").Value
            If LCase(Blad) Like LCase("AfasAdminSheet") Then GoTo Opnieuw
            For Each wb In Worksheets
                If LCase(Blad) Like LCase(wb.Name) Then GoTo Overslaan
            Next
            Worksheets.Add.Name = Blad
            With Sheets(Blad)
                .Range("A1").Resize(, 4) = Split(Join(Application.Index(Sheets("Blad1").Range("a1").Resize(, 4).Value, 1, 0), "|"), "|")
                .Columns("A:A").ColumnWidth = 25
                .Columns("B:B").ColumnWidth = 45
                .Columns("C:E").ColumnWidth = 13
                .Move , Sheets(Sheets.Count)
            End With
Overslaan:
            Sheets(Blad).Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 4) = .Cells(c.Row, "A").Resize(, 4).Value
Opnieuw:
        Next
    End With
    Application.ScreenUpdating = True
End Sub

 

[NoVaX]

vanuit het programma heb ik regels toe kunnen voegen voor het exporteren. Nu worden automatisch alle bladen geexporteerd.

Had handig geweest als ik daar eerder achter was gekomen, maar het werk nu naar behoren. Bovendien is dit voor mij makkelijker aan te passen. Hartelijk bedankt voor de tijd/moeite