3 werkbladen samenvoegen op 1 werkblad

[Woscibol]

Beste forumleden,

Ik wil graag drie specifieke werkbladen (in dit geval: 'nummer 1', 'nummer 2' en 'nummer 3') samenvoegen in één werkblad 'totaaloverzicht' onder elkaar weergegeven. Zie bijlage. Bekijk bijlage CONCEPT2 Voorbeeld.xlsm

Van de 3 werkbladen wil ik alle kolommen en rijen met ingevulde gegevens overnemen, behalve de rij 2 in alledrie de werkbladen.

Hoe kan ik dit het beste aanpakken?

 

[HSV]

Is dat echt nodig voor een leeg bestand?

 

[Woscibol]

Wordt uiteraard ingevuld met data..

 

[HSV]

Dan is het een slecht voorbeeld bestand.
Ook 'totaaloverzicht' ontbreekt.

Ik kan diverse codes uit de hoed toveren, maar meestal is het niet goed door een slecht voorbeeld.

 

[Woscibol]

Excuus. Ik kan helaas niet alle data invoeren ivm privacy. Maar werkt dit bestand beter? Bekijk bijlage CONCEPT3 Voorbeeld.xlsm

 

[HSV]

We willen ook geen privacy info (dat melden we zelfs aan de moderator mocht het er per ongeluk wel instaan).

Lukt het je hiermee?

Sub hsv()
Dim sh, sn
  For Each sh In Array("nummer 1", "nummer 2", "nummer 3")
    sn = Sheets(sh).Cells(1).CurrentRegion.Offset(2)
    Sheets("totaaloverzicht").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(sn), UBound(sn, 2)) = sn
  Next sh
End Sub

 

[Woscibol]

Top! Thnx.

Is het ook mogelijk om de titel in Rij 1 van de werkbladen mee te kopiëren naar het werkblad totaaloverzicht?

 

[HSV]

Probeer het maar eens.

Sub hsv_2()
Dim sh
Application.ScreenUpdating = False
For Each sh In Array("nummer 1", "nummer 2", "nummer 3")
 With Sheets("totaaloverzicht").Cells(Rows.Count, 1)
  Sheets(sh).Cells(1).Resize(, 10).Copy .End(xlUp).Offset(1)
  Sheets(sh).Cells(1).CurrentRegion.Offset(2).Copy .End(xlUp).Offset(1)
 End With
Next sh
End Sub

 

[Woscibol]

Fantastisch dat werkt!

Ik heb de macro nu onder een knop zitten, als ik meerdere keren op de knop druk, komt de uitkomst steeds onder elkaar (in de lege cellen). Ik wil het graag iedere keer weer laten overschrijven vanaf 't begin (2e rij).

 

[HSV]

dat kan ook.

Sub hsv_3()
Dim sh
Application.ScreenUpdating = False
With Sheets("totaaloverzicht").Cells(Rows.Count, 1)
.Parent.Cells(1).CurrentRegion.Offset(1).Clear
    For Each sh In Array("nummer 1", "nummer 2", "nummer 3")
      Sheets(sh).Cells(1).Resize(, 10).Copy .End(xlUp).Offset(1)
      Sheets(sh).Cells(1).CurrentRegion.Offset(2).Copy .End(xlUp).Offset(1)
    Next sh
 End With
End Sub

 

[Woscibol]

Veel dank! Het is allemaal gelukt!

 

[Woscibol]

Toch nog een vraagje. Ik voer de macro uit en krijg een mooi lijstje. Dat werkt uitstekend. Als ik nu per ongeluk onder dit lijstje iets typ, en de macro opnieuw uitvoer, komt de nieuwe data onder de getypte tekst te staan. Is dit te omzeilen zodat hij altijd overschrijft en weer bovenaan (rij 2) begint?

 

[VenA]

Wijzig .currentregion in .usedrange in regel 5 (denk ik)

 

[Woscibol]

Dat is het helaas niet. Krijg foutmelding: 438 Deze eigenschap of methode wordt niet ondersteund door dit object.

 

[HSV]

Vermijd de samengevoegde cellen in de kopteksten van elk blad.
Zo lijkt het precies hetzelfde als je de tekst gecentreerd over de selectie doet.