• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Rijen van verschillende tabbladen kopiëren met voorwaarde naar 1 tabbald

Status
Niet open voor verdere reacties.
D

diamondbrother

Gebruiker
Lid geworden
14 apr 2007
Berichten
36
Hallo,

Ik heb hier een testblad waarmee ik volgende moet doen.
er zijn verschillende chauffeurs (tabbladen op naam (Koen, Stefaan,... er komen er nog bij) die met verschillende busjes rijden (kolom Busjes)
de ritten staan geregistreerd in de tabbladen met hun naam (koen, Stefaan,...)
de bedoeling is dat die verschillende tabbladen allemaal gesorteerd worden in andere tabbladen (busje 1, busje 2,...) zodat de kilometerregistratie correct kan uitgerekend worden per busje.
dus de ganse rij moet volledig gekopieerd worden (uitgezonderd kolom I en J) naar busje 1 indien er in de rij in kolom busje "Busje 1" geschreven staat. of "Busje 2" naar tabblad busje 2,... enz.....
ik heb geprobeerd met vlookup maar die geeft maar 1 waarde van de rij weer. ik heb index getest, en nog enkele andere dingen, mss een macro? heeft iemand hier een concrete oplossing?

Bekijk bijlage testblad.xlsm

wie kan mij helpen?
alvast bedankt
 
Met een filtertje.
Code: 
Sub hsv()
Dim sv, arr, sh As Worksheet, i As Long, j As Long, c00 As String
For Each sh In Sheets(Array("koen", "stefaan"))
 With sh.ListObjects(1).DataBodyRange
  sv = .Value
     For i = 1 To UBound(sv)
      If InStr(c00, sv(i, 4)) = 0 And sv(i, 4) <> 0 Then c00 = c00 & "|" & sv(i, 4)
     Next i
 arr = Split(Mid(c00, 2), "|")
  For j = 0 To UBound(arr)
   If IsError(Evaluate("'" & arr(j) & "'!A1")) Then Sheets.Add(, Sheets(Sheets.Count)).Name = arr(j)
    .AutoFilter 4, arr(j)
    .Resize(, 8).Copy Sheets(arr(j)).Cells(Rows.Count, 1).End(xlUp).Offset(1)
    .AutoFilter
  Next j
 End With
   c00 = ""
   Erase sv
   Erase arr
 Next sh
End Sub
 
Mijn suggesties hier vind ik beter http://www.helpmij.nl/forum/showthread.php/930591-Excel-rijen-kopi%C3%ABren-naar-ander-tabblad

Code: 
Sub VenA()
ar = Sheets("Voertuig").Cells(1).CurrentRegion
  For Each sh In Sheets(Array("Koen", "Stefaan"))
    For j = 2 To UBound(ar)
      If IsError(Evaluate("'" & ar(j, 1) & "'!A1")) Then Sheets.Add(Sheets(Sheets.Count)).Name = ar(j, 1)
      With sh.ListObjects(1).DataBodyRange
        .AutoFilter 4, ar(j, 1)
        .Resize(, 8).Offset(1).Copy Sheets(ar(j, 1)).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        .AutoFilter
      End With
    Next j
  Next sh
End Sub
 
Je suggestie is aan de code te zien.
Eerst alle bladen van de werknemers naar een apart blad, en dan vanuit daar opnieuw verdelen.

Zo te zien aan de link heeft de Ts daar niet veel aan he. :p

Ik ben gestopt met suggesties en beantwoord gewoon de vragen; of het moet qua uitvoer niet kunnen.
 
Druk Alt+F11.
Menu invoegen → Module.
Code plakken in het grote witte vlak.
Alt+Q.
 
@HSV, Ik blijf nog 'even' mijn handtekening trouw.:d Deze zin begrijp ik niet uit jouw reactie: "Eerst alle bladen van de werknemers naar een apart blad, en dan vanuit daar opnieuw verdelen." Dit zal zeer zeker niet in mijn suggestie staan en de code doet dat ook niet. Als er een vraag komt 'Waar moet ik die codes invoeren/kopieren?' dan is de suggestie om de basis van Excel te gebruiken zo gek nog niet.;)

Met 1 keer controleren of de tabjes bestaan en dan alles maar weer opbouwen wat eigenlijk niet nodig hoeft te zijn.

Code: 
Sub VenA()
  Application.ScreenUpdating = False
  ar = Sheets("Voertuig").Cells(1).CurrentRegion
  For j = 2 To UBound(ar)
    If IsError(Evaluate("'" & ar(j, 1) & "'!A1")) Then Sheets.Add(Sheets(Sheets.Count)).Name = ar(j, 1)
    Sheets(ar(j, 1)).Cells.Clear
    Sheets(ar(j, 1)).Cells(1).Resize(, 8) = Split("Datum Soort_Rit Traject Busje Chauffeur Tankbeurt Km_Begin Km_Eind")
  Next j
  
  For Each sh In Sheets(Array("Koen", "Stefaan"))
    For j = 2 To UBound(ar)
      With sh.ListObjects(1).DataBodyRange
        .AutoFilter 4, ar(j, 1)
        .Resize(, 8).Offset(1).Copy
        Sheets(ar(j, 1)).Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial 12
        .AutoFilter
        With Sheets(ar(j, 1)).Cells(1).CurrentRegion
          .Columns.AutoFit
          'andere opmaak dingetjes
          .Sort .Cells(1), , , , , , , xlYes
        End With
      End With
    Next j
  Next sh
End Sub
 
@VenA, ik zag in jouw code "voertuig" staan, dus was ik er vanuit gegaan dat je een bestandje had geplaatst in die link waar daar alles eerst verzamelt werd door een of ander codes.
In die link heb ik alleen de laatste reactie gelezen (die bij mij bovenaan staat) dat Ts aan jou suggesties niet veel heeft.

Als er bestanden worden geplaatst, ga ik niet onderzoeken of er verborgen bladen tussen zitten.
"busje 1,2,3 enz." komen trouwens voort uit een ander bestand (zie de koppelingen in de formules).

Ts doet z'n voordeel er maar mee, en anders maar niet.

Ps. Ik denk dat als er een oplossing tussen zit dat je niets meer verneemt van @diamondbrother‎ (die reageert alleen als het niet wil of snapt).
 
Laatst bewerkt:
euh excuseer,
ik reageer enkel als ik zekerheid heb ik moet dat bespreken met de juiste mensen, ik laat jullie zeker nog iets weten, maar ik heb het al ff getest, en het is prima, waarvoor dank, enkel zal ik ipv 2 chauffeurs (koen en stefaan) meerdere chauffeurs moeten invoegen, verandert er dan iets aan de code?
een tweede ding die zou moeten gebeuren is dat er een kolom bijkomt (I) in de tabbladen die bijgemaakt worden met als titel "#Km's" en daar moeten dan de gereden kms in komen (automatisch) bvb (=h2-g2) en die kolom cursief en vet, maar daarvoor moet eerst de lijst gesorteerd worden op kms dus kolom G en datum kolom A.
en ook automatisch totalen van tankbeurt en kolom I.

alvast bedankt

echt super bedankt en ik heb hier veel uit geleerd, ook op het gebied hoe mensen reageren. ;-)
 
Laatst bewerkt:
Het lijkt mij evident dat je de code moet aanpassen. Als je niet begrijpt wat er staat gebruik het dan niet. Wie zijn die juiste mensen dan? Vraag bij de juiste mensen een basiscursus Excel aan. Leg ook even aan deze juiste mensen uit dat je eenduidige data veel beter in 1 tabel kan verzamelen ipv alles op verschillende tabjes te zetten. Stel je krijgt de vraag om een overzichtje te maken van wie in week 9 op welke dag met welk voertuig op pad is geweest. Volgens mij ben je dan wel even bezig. Of iets complexer; wil je even een jaaroverzicht per voertuig maken? Ooit gaat het kwartje wel vallen.:d
 
dag VenA
ik ben heel vereerd dat je de tijd neemt om dit te beantwoorden, respect voor je kennis echt waar. Dit doe ik nu even op vrijwillige basis, ik heb kleine kennis van excel, maar niet van macro's en vba. die uitleg die je mij geeft is idd helemaal waar, en ik heb net het zelfde uitgelegd aan die personen (de verantwoordelijken van die dienst) om een voorbeeld te geven hoe weinig zij er van kennen..... ze maken een planning van chauffeurs in WORD :eek: ja stom he ik weet het maar het is nu even zo... en een overzichtje van een week, of op jaarbasis?...... daar slaat hun kop van op hol denk ik ze denken daar niet aan. als het gene ik hierboven vraag al lukt dan eten ze wel uit mijn hand als ik iets zeg, van "dit is te moeilijk" of "dat gaat niet" ze zullen dat dan ook wel aanvaarden. mss zet dit voor mij een extra deur open.
 
hallo,

ik krijg sinds kort een foutcode 400 bij uitvoer van deze macro,
kan je aub mijn bericht van vorige keer uitvoeren aub? thx
en dan bedoel ik dit :
een tweede ding die zou moeten gebeuren is dat er een kolom bijkomt (I) in de tabbladen die bijgemaakt worden met als titel "#Km's" en daar moeten dan de gereden kms in komen (automatisch) bvb (=h2-g2) en die kolom cursief en vet, maar daarvoor moet eerst de lijst gesorteerd worden op kms dus kolom G en datum kolom A.
en ook automatisch totalen van tankbeurt en kolom I.
 
Laatst bewerkt:
Dit is een vraag voor helderzienden? Welke macro? Welk bericht van de vorige keer moet uitgevoerd worden? Zoek eens op debuggen VBA mogelijk vindt je dan zelf een oplossing.
 
Helderzienden zien dat ik de vraag herhaald heb in mijn vorige bericht............????? Excuseer maar ik vraag hulp, met zo’n antwoord heb ik er niets aan hè, help gewoon of blijf hier weg. :evil:
 
@VenA

Dit bericht wenst TS nog uitgewerkt te zien:

diamondbrother zei:
een tweede ding die zou moeten gebeuren is dat er een kolom bijkomt (I) in de tabbladen die bijgemaakt worden met als titel "#Km's" en daar moeten dan de gereden kms in komen (automatisch) bvb (=h2-g2) en die kolom cursief en vet, maar daarvoor moet eerst de lijst gesorteerd worden op kms dus kolom G en datum kolom A.
en ook automatisch totalen van tankbeurt en kolom I.
Klik om te vergroten...

@diamondbrother

Het is op het moment niet duidelijk welk gedeelte van de code je hebt gebruikt, plak de code die je momenteel hebt even in een antwoord of wijs even aan welke code het betreft uit de antwoorden hierboven.

@allen, laten we het dan verder nog even gezellig houden ;)

Met vriendelijke groet,
Rick van Lieshout
 
Laatst bewerkt:
Hallo iedereen,

@mastermindzh
@VenA

Code: 
Sub VenA()
  Application.ScreenUpdating = False
  ar = Sheets("Voertuig").Cells(1).CurrentRegion
  For j = 2 To UBound(ar)
    If IsError(Evaluate("'" & ar(j, 1) & "'!A1")) Then Sheets.Add(Sheets(Sheets.Count)).Name = ar(j, 1)
    Sheets(ar(j, 1)).Cells.Clear
    Sheets(ar(j, 1)).Cells(1).Resize(, 8) = Split("Datum Soort_Rit Traject Busje Chauffeur Tankbeurt Km_Begin Km_Eind")
  Next j
  
  For Each sh In Sheets(Array("Koen", "Stefaan"))
    For j = 2 To UBound(ar)
      With sh.ListObjects(1).DataBodyRange
        .AutoFilter 4, ar(j, 1)
        .Resize(, 8).Offset(1).Copy
        Sheets(ar(j, 1)).Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial 12
        .AutoFilter
        With Sheets(ar(j, 1)).Cells(1).CurrentRegion
          .Columns.AutoFit
          'andere opmaak dingetjes
          .Sort .Cells(1), , , , , , , xlYes
        End With
      End With
    Next j
  Next sh
End Sub


de bovenstaande code werkt, waarvoor oprechte dank, maar na het testen heb ik gezien dat de code telkens de eerste rij (lijn 7 in elk tabblad) overslaat, en die dus niet in het overzicht per busje opneemt.
kunnen jullie dit oplossen?
kan er ook nog een kollom aan toe gevoegd worden waarin hij de eindstand aftrekt van de beginstand?
indien nodig stuur ik de bestanden nog eens door.

alvast bedankt,

Stefaan
 
Laatst bewerkt door een moderator:
De code is bijna goed dus waarom plaats je niet gelijk het bestandje?
 
bestandje toegevoegd

Dag VenA

bedankt voor je reactie, hierbij voeg ik het juiste bestandje. let wel op de tekst die ik onderaan mijn vorige bericht zette he.

de bovenstaande code werkt, waarvoor oprechte dank, maar na het testen heb ik gezien dat de code telkens de eerste rij (lijn 7 in elk
tabblad) overslaat, en die dus niet in het overzicht per busje opneemt.
kunnen jullie dit oplossen?
kan er ook nog een kollom aan toe gevoegd worden waarin hij de eindstand aftrekt van de beginstand?

dit is het bestandje : Bekijk bijlage Maart 2018.xlsm


alvast bedankt voor al jouw moeite, en veel respect voor je kennis.. :thumb:
 
dag VenA

het zou leuk zijn indien de datum kollom een kalender kon tonen als je er op klikt dan kunnen ze zelf de datum kiezen.
 
Ipv te filteren op de databodyrange moet je filteren op de range.
Code: 
With sh.ListObjects(1).Range

Over kalenders in Excel is voldoende te vinden.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan