Samenvoegen van gegevens van diverse tabbladen naar een verzamelblad

[radar]

Excellenties,

Heb een bestand met naast een tabblad verzamelblad een variabel aantal tabbladen.
Middels een macro heb ik in bijlage de gegevens samengevoegd.
Alle records waarbij kolom A is ingevuld van de volgende tabbladen C t/m A gaan naar verzamelblad.
Nu heb ik in voorbeeld met 3 tabbladen de bladen met naam benoemd en de uit te voeren actie steeds herhaald.
Het echte bestand is vele malen groter en qua aantal tabbladen variabel (bladen kunnen toegevoegd worden, verplaatst, verwijderd)
Kan iemand mij helpen om de macro dusdanig te schrijven, dat de uit te voeren actie uitgevoerd wordt over een "range van tabbladen", waarbij ik begin en eindtabblad kan aangeven ?
In voorbeeld zou tabblad Opmerkingen niet meegenomen dienen te worden.
Opdracht zou dus moeten zijn voer de actie uit voor de tabbladen C t/m A, waarbij in echt bestand het aantal en de benaming anders zal zijn.

Met vriendelijke groet,
Radar

 

[jkpieterse]

Kan ook middels ophalen en transformeren.

Heb eerst een formule gescrheven die de bestandsnaam geeft (cel B1 op eerste tabblad). Die cel heb ik de naam "Dit_bestand" gegeven.
Vervolgens heb ik een powerquery functie geschreven die de waarde uit die naam kan vissen (gekopieerd van hier: https://www.howtoexcel.org/power-query/how-to-reference-a-named-range-in-power-query/)
Daarna heb ik een query gebouwd middels "Nieuwe query, van bestand".
Dan bestand aanwijzen en op OK klikken.
Dan NIET de werkbladen aanvinken maar de naam van het bestand aanklikken
Dan op Transformeren klikken (ik heb ENgelse versie, tekst kan bij jou in NL anders zijn)
Dan kolom toevoegen die de lengte van de naam van de tabs berekend (Text.Length functie)
Filteren op die kolom, waarde 1
De nu overbodige kolommen weggooien zodat alleen de tab naam en een kolom met "Table" erin overblijft
op de kleine knop in de kop van die kolom klikken om te expanderen
Alle lege rijen verwijderen
Eerste rij als koprij instellen
Filteren om de tussentitels kwijt te raken
Handmatig de query in de geavanceerde edito bewerken om de hard-coded bestandsnaam te vervangen door fnGetNamedRange("Dit_bestand")

 

[radar]

Allereerst dank voor de snelle reactie en het gedane werk.
Ik heb geen powerquery ter beschikking in mijn Excelversie.

Radar

 

[jkpieterse]

Je kunt het gratis downloaden...

 

[radar]

In mijn thuisomgeving heb dat ook; daar zal ik hiermee aan de slag gaan; echter dit wil ik mijn werkomgeving toepassen....; daar kan ik dit niet downloaden...

 

[jkpieterse]

Jammer voor je Hoogste tijd voor een upgrade van Office.

 

[VenA]

Dan maar met VBA

Sub VenA()
  Dim sh As Worksheet
  With Sheets("Totaalblad")
    .Cells(2, 1).CurrentRegion.Offset(1).Clear
    For Each sh In Sheets
      If InStr("TotaalbladOpmerkingen", sh.Name) = 0 Then sh.Cells(2, 1).CurrentRegion.Offset(1).Copy .Cells(Rows.Count, 1).End(xlUp).Offset(1)
    Next sh
  End With
End Sub

 

[radar]

Dank VenA,
Macro doet waar ik om gevraagd heb; ga dit morgen inpassen in "echt bestand".
Ben vandaag onderweg.

Radar

 

[radar]

V en A,

VBA werkte prima in het dummie-bestand, in het werkbestand echter niet.
Ofschoon ik wel de intentie had het dummie-bestand qua structuur net zo te maken als werkbestand heb ik wat over het hoofd gezien...
De "Current Region" als selectie is toch groter dan nodig; het zou bereik A4:U50 mogen worden, wat telkens gekopieerd wordt van de diverse tabbladen zoals gedefinieerd naar het verzamelblad.
Zou je met die info het stukje vba willen aanpassen ?

Alvast dank !

Radar

 

[VenA]

Dan wordt het

sh.range("A4:U50").copy

 

[snb]

Updaten van Office lijkt me niet nodig, tenzij je notoire belastingontduikers wil sponsoren.
Powerquery voor zo'n simpele taak een kanon op een mug.

Soortgelijke voorzieningen bevat VBA al jaren (als je ze tenminste weet te vinden).

Sub M_snb()
    For Each it In Sheets
        If InStr("TotaalbladOpmerkingen", it.Name) = 0 Then
            With CreateObject("ADODB.Recordset")
                .Open "SELECT * FROM `" & it.Name & "$`", "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0 Xml"""
                Sheets("Totaalblad").Cells(Rows.Count, 1).End(xlUp).Offset(1).CopyFromRecordset .DataSource
            End With
        End If
     Next
 End Sub

NB. Gebruik in werkbladen altijd rij 1 en cel A1.

 

[jkpieterse]

Klopt snb, VBA kan alles zeker als je de externe libraries weet te vinden. Maar dat kanon waarmee je op die mug schiet is wel makkelijker voor de gemiddelde Excel gebruiker dan VBA.

 

[radar]

@VenA

Dank voor aanpassing.

Vanochtend script toegepast op echte omgeving.
Met bereik per tabblad werkt nu.
(Ik had zelf bereik Range("A4:U50") zonder succes geprobeerd zonder sh. vooraf).
Echter

If InStr("TotaalbladOpmerkingen", sh.Name)>

bakent helaas niet het bereik af van het blad waarnaar gekopieerd moet worden tot en met het laatste blad.
Het scriptje neemt ook de voor Totaalblad gelegen tabs mee.
Kun je me vba scriptje maken op basis van aantal tabbladen sheets.count op basis van positie verzamelblad ?

Dank alvast voor oplossing en geduld...

 

[VenA]

Sub VenA()
  Dim sh As Worksheet, j As Long
  With Sheets("Totaalblad")
    .Cells(2, 1).CurrentRegion.Offset(1).Clear
    For j = .Index + 1 To Sheets.Count
      Sheets(j).Range("A4:U50").Copy .Cells(Rows.Count, 1).End(xlUp).Offset(1)
    Next j
  End With
End Sub

 

[radar]

VenA

Werkt prima zo !

Dank voor hulp en geduld..!