Cellen met dezelfde titel kopieren

[NogGeenGuru]

Goedemiddag forumleden,

Ik heb een bestandje waarin projecten bijgehouden worden.
nou worden alle type-projecten bijgehouden op verschillende tabbladen. veel projecten zijn zo verschillend dat het een rommeltje wordt om alles in 1 tabel bij te houden.

nou zijn er gelukkig ook dingen die wel overeen komen. ik heb deze in elke tabel dezelfde kop (rij1) gegeven.
nou wil ik graag dat op blad1 (Import) alle gegevens verzameld worden uit de andere tabbladen met dezelfde kop.
(met het voorbeeld bestandje is het allemaal een stuk duidelijker)

ik heb de koppen die op het "Import" tabblad te vinden zijn blauw gekleurd. de koppen die daar niet terug te vinden zijn heb ik grijs gekleurd.

Ik probeer het voor elkaar te krijgen dat de tabellen die overeen komen worden gekopieerd naar het import tabblad.
nou zijn er in het echte bestand erg veel tabbladen en kunnen er in de toekomst meerdere koppen aan "import" worden toegevoegd.

Het is dus erg belangrijk dat wanneer ik een kop toevoeg aan import en/of een tabblad invoeg dat deze meegenomen worden.
hier loop ik helemaal op vast

is er hier misschien iemand die de uitkomst weet?

mvg,

 

[VenA]

Met een macro. Zorg er wel voor dat de celeigenschappen in kolom H op standaard staan.

Sub VenA()
Dim j As Long, jj As Long, jjj As Long, t As Long, ar, ar1, ar2
With Sheets("Import")
    ar = .Rows(1).SpecialCells(2)
    For Each sh In Sheets
        If sh.Name <> "Import" Then
            t = 1
            ar1 = sh.Cells(1).CurrentRegion
            ReDim ar2(1 To UBound(ar1), 1 To UBound(ar, 2))
            For j = 1 To UBound(ar, 2)
                For jj = 1 To UBound(ar1, 2)
                    If ar(1, j) = ar1(1, jj) Then
                        For jjj = 2 To UBound(ar1)
                            ar2(t, j) = ar1(jjj, jj)
                            t = t + 1
                        Next jjj
                        t = 1
                    End If
                Next jj
            Next j
            .Cells(.Rows.Count, 2).End(xlUp).Offset(1, -1).Resize(UBound(ar2), UBound(ar2, 2)) = ar2
        End If
    Next sh
End With
End Sub

 

[NogGeenGuru]

Dankjewel VenA, Deze macro werkt geweldig!:thumb:

 

[NogGeenGuru]

Beste VenA,

na je macro een tijdje gebruikt te hebben heb ik gemerkt dat er bepaalde rijen overgeslagen worden.
van bepaalde tabbladen valt de laatste regel steeds weg. als ik het tabblad helemaal naar achter verplaats (zodat de waardes als laatste worden overgenomen) wordt de laatste regel wel mee genomen.
Ik denk dus dat de laatste regel overschreven wordt ofzo... maar vreemd genoeg gebeurt dit maar bij 2 van de 19 tabbladen die ik gebruik

ik heb mijn bestandje even ingekort zodat ik deze kan uploaden op het forum.
de grote "update knop" zet jou macro in werking. door te schuiven in de tabbladen kun je zien dat de laatste regel steeds weg valt.

ik heb geprobeerd dit zelf op te lossen maar ik kom er niet uit
mijn kennis van macro's is helaas nog niet op het niveau van de jouwe, ik begrijp niet helemaal hoe jou macro werkt.

zou je er nog even naar willen kijken voor me?

alvast bedankt!:thumb:

 

[VenA]

Dat komt omdat kolom B lege cellen bevat. Hierdoor wordt de laatste rij niet correct bepaald.

Maak er eens dit van

.Cells(.Rows.Count, [COLOR="#FF0000"]10[/COLOR])

 

[NogGeenGuru]

Hoi VenA,

Bedankt voor je berichtje.
als ik :

.cells(.rows.count,10)

toepas worden de gegevens in de 10de kolom op het "projecten" tabblad geplaatst. (misschien dat ik de verkeerde aanpas hoor)

wat misschien wel kan helpen is dat de kolom "Project-Soort" op elk tabblad staat en op elke rij gevuld is. (hiermee heb ik altijd de laatste regel bepaald)
maar omdat ik niet goed weet hoe deze macro precies werkt weet ik niet hoe ik dat kan implementeren.

zou jou macro daar misschien op kunnen zoeken? en zo ja, Hoe doe ik dat precies?

mvg,

 

[VenA]

De offset die er achter staat moet je ook nog even aanpassen.

 

[NogGeenGuru]

Ah nou doet hij het idd.

VenA, ik Wil je ontzettend bedanken:thumb:

 

[VenA]

En zo wordt je vanzelf een Guru:d