kopieren,plakken met voorwaarde

[broek76]

Goedemorgen,

In de bijlage zit een bestand met op blad 1 namen en weekdagen. Nu wil ik de namen waar een 1 achterstaat kopiëren naar blad 2 onder de goede dag zonder lege cellen er tussen.
Heeft iemand hier een macro voor die werkt als ik het bestand opsla?

Mvg Ron

 

[Elsendoorn2134]

Ron,

Ik begrijp je vraag niet.
- Achter alle namen staan meerdere keren een 1, welke namen wil je nu hebben.
- Als ik alle namen kopieer als er een 1 staat heb je geen macro nodig en kun je dit met een simpele formule regelen (=ALS(Blad1!B3=1;Blad1!$A3;"").
- Daarna wil je ook nog lege cellen verwijderen? Welke dan?

Ik stel voor dat je op tabblad 2 even aangeeft hoe het eindresultaat er uit moet zien.

Veel Succes.

 

[broek76]

In kolom A staan de namen en in rij 2 de weekdagen(maandag tm vrijdag).
De 1 staat voor afdeling 1 dus op maandag werken op afdeling 1: Piet, Klaas, Fred en Desiree.
Blad 1 is om in te vullen en blad 2 om op de afdeling te hangen.

Met de formule komen tussen Fred en Desiree twee lege cellen en dat is dus niet de bedoeling.

Ik heb in het voorbeeld nu ingevuld wat het resultaat zou moeten zijn.

Ik kan natuurlijk kopiëren en plakken maar dit is alleen een voorbeeld bestandje waarmee ik hoop op weg geholpen te worden. In het uiteindelijke bestand gaat het om 120 personen die verdeeld worden over 7 afdelingen.

Hopelijk is het zo duidelijker.

 

[Elsendoorn2134]

Ron,

Dit zijn altijd wat lastige vragen vandaar dat het wat lang geduurd heeft.
Ik heb een oplossing voor je gemaakt waarbij ik een kleine uitbreiding heb gemaakt
op jouw vraagstelling door twee afdelingen te maken in plaats van een.
Ik heb in de code toelichtingen geschreven zodat je deze kunt volgen.

Bekijk bijlage HelpMijSplitsAfdeling.xlsm

Veel Succes.

 

[sylvester-ponte]

Elsendoorn,
Dit kost relatief veel rekenwerk.
Waarom niet gelijk plaatsen in de afdelings bladen, ipv eerst in een tabel?

 

[Elsendoorn2134]

Sylvester ponten,

Dank voor je reactie veel rekenwerk vraagt het niet wel enige interne blokkering van geheugen maar dit is maixmaal 1 mb voor 100 records.
Ik stel voor dat je een alternatief maakt.

Elsendoorn2134

 

[sylvester-ponte]

ik heb jouw sub geleend en aangepast:

Public Sub BouwFormulier2()
Dim nLoper As Integer           'Rijteller
Dim nKolom As Integer           'Kolom teller
Dim nRecord As Integer          'Telt de records die gemaakt worden
Dim aAfd As Integer             'Bevat nummer voor het aflopen van de tabbladen
Dim Naar As Range
Dim RijGehPerBlad(5, 2) As Integer

With Sheets("Schema").Range("A3")
    Do While .Offset(nLoper, 0) <> ""       'Doorloop de kolom A tot er geen naam meer genoemd wordt
        For nKolom = 1 To 5
            aAfd = .Offset(nLoper, nKolom)
            If aAfd > 0 Then                 'Staat er een getal dan opslaan gegevens
                Set Naar = Sheets("Afd" & aAfd).Range("B7") 'begin locatie van uitvoer
                Naar.Offset(RijGehPerBlad(nKolom, aAfd), nKolom - 1) = .Offset(nLoper, 0)
                RijGehPerBlad(nKolom, aAfd) = RijGehPerBlad(nKolom, aAfd) + 1
            End If
        Next
        nLoper = nLoper + 1
    Loop
End With
End Sub

ps het antwoord wordt in B7 begonnen

 

[Elsendoorn2134]

Sylvester Ponten,

Mooi alternatief, liep me even af te vragen wat de RijGehPerBlad(5, 2) in hield maar dit is een matrix
om bij te houden op welke regel het antwoord moet worden geplaatst.
Mooi kort. dank je.

Elsendoorn2134

 

[broek76]

Elsendoorn en Sylvester,

Werkt super, allebei hartelijk dank voor jullie hulp.

Gr Ron

 

[sylvester-ponte]

Elsendoorn, je hebt helemaal gelijk.
Ik moet duidelijker aangeven waarvoor iets gebruikt wordt,
en ga proberen mijn leven te beteren.