VBA Samenvoegen van bladen

[mooske04]

Luitjes,

In bijgevoegd testbestand wil ik graag de bladen adv1 en adv2 samenvoegen tot het totaal.

Bij mijn zoektocht op het forum kwam ik deze tegen:

Sub Samenvoegen()
Dim iWS As Integer
Dim lSRij As Long

    Worksheets.Add After:=Worksheets(Worksheets.Count)
    With Worksheets(Worksheets.Count)
        Worksheets(1).Range("A1:I1").Copy .Range("A1:I1")
        lSRij = 2
        For iWS = 1 To Sheets.Count - 1
            Worksheets(iWS).Range("A2:I" & Worksheets(iWS).Range("I" & Rows.Count).End(xlUp).Row).Copy .Range("A" & lSRij)
            lSRij = .Range("B" & Rows.Count).End(xlUp).Row + 1
        Next
        .Range("A2:I" & lSRij).Sort key1:=Range("B2")
    End With
End Sub

maar weet niet precies hoe hem om te bouwen. Ik zie de verwijzing niet helemaal. Iemand die me verder kan helpen?

 

[ExcelAmateur]

mooske04,

Kijk in de file voor uitleg.

 

[mooske04]

Bedankt voor het meedenken! Grotendeels is dit hem, maar nognet niet helemaal...

Ik wil graag de uren van adv1 1 in de kolom van adv1 en die van adv2 in de kolom van adv2. En dan natuurlijk bij voorkeur zonder knop, maar "gewoon" in de programmacode.
Nog meer suggesties?

 

[ExcelAmateur]

mooske04,

Het werkt nog steeds met de knop.
Test het even of je het nu zo bedoelt.

Hoe zou je het dan automatisch willen laten werken?

 

[mooske04]

ExcelAmateur (ha! kan ik beter over mezelf zeggen!)

Ik zou graag willen dat het eruit ziet zoals het totaalblad, dus de uren in verschillende kolommen, niet in 1 kolom. En met automatisch bedoel ik niet dmv een knop, maar mss dat de code van de macro in de programmacode van het totaalblad kan komen te staan en dus automatisch als er nieuwe uren bijkomen die in het totaaloverzicht in de kolom van de betreffende adv komen te staan....

 

[ExcelAmateur]

Zo'n kei ben ik er niet in hoor.
Het laatste stukje code had ik opgenomen en het overtollige verwijderd.

Misschien dat er iemand is, die dit voor je kan oplossen.

Zelf zal ik kijken maar denk niet, dat dit mij gaat lukken.

 

[wampier]

Automatisch moet je heel erg mee oppassen. De belasting op de performance neemt vaak exponentieel toe, vooral omdat de automatische bewerking op elke sheet moet worden gedaan. Bovendien moet bij elke sheet dan de code worden toegevoegd.

Het beste is om de data te aggregeren en de macro op te roepen als het nodig is. Je kunt eventueel wel een sneltoets aanmaken om de macro op elk gewenst moment te starten.

Sub doen()
Range("3:30000").ClearContents
For Each blad In Worksheets
    
    If Left(blad.Name, 3) = "adv" Then
    tellen = tellen + 1
    Sheets("totaal").[a2].Offset(0, 3 + tellen).Value = blad.Name
        For Each regel In Range(blad.[a2], blad.[a50000].End(xlUp))
            Union(regel, Range(regel.Offset(0, 3), regel.Offset(0, 5))).Copy (Sheets("totaal").[a50000].End(xlUp).Offset(1))
            Sheets("totaal").[a50000].End(xlUp).Offset(0, 3 + tellen).Value = regel.Offset(0, 1).Value
        Next regel
    End If
Next blad

End Sub