3 werkbladen samenvoegen

[Fenadna]

Ik heb 3 werkbladen met dezelfde indeling in kolommen. Nu wil ik de gegevens uit deze 3 bladen in 1 werkblad zetten, gewoon onder elkaar. Bij opnieuw inlezen van de gegevens fluctueert het aantal rijen per werkblad. Weet iemand ik dat voor elkaar moet krijgen?

 

[Niels28]

Lastig zonder voorbeeld,
maar zo zou het kunnen.

Sub test()
For Each sh In ThisWorkbook.Sheets
If Not sh.Name = "Blad1" Then
sh.Range("A1").CurrentRegion.Copy Destination:=Sheets("blad1").Range("A" & Cells(Rows.Count, "A").End(xlUp).Row + 1)
End If
Next
End Sub

Niels

 

[Fenadna]

Waar kan ik deze tekst plaatsen? Ik heb nooit met VBA gewerkt.

 

[Niels28]

Alt-f11
rechtermuisknop links in beeld op de naam van het excelstand => invoegen => module
en daar zet je hem in.
Met f5 voer je hem uit.

Niels

 

[Fenadna]

Ik krijg de foutmelding dat het subscript buiten het bereik valt. Moet ik "blad 1" nog een andere naam geven?

 

[Niels28]

Blad1 moet je vervangen door de naam van het tabblad waarop je de gegevens wilt samenvoegen.

Niels

 

[Fenadna]

er staan nog meer tabbladen in het bestand, is dat nog een probleem?

 

[Niels28]

Zoals ik al aangaf in mijn eerste post een voorbeeld bestandje is wel makkelijk.

Sub test()
Sheets("blad2").Range("A1").CurrentRegion.Copy Destination:=Sheets("blad1").Range("A" & Cells(Rows.Count, "A").End(xlUp).Row + 1)
Sheets("blad3").Range("A1").CurrentRegion.Copy Destination:=Sheets("blad1").Range("A" & Cells(Rows.Count, "A").End(xlUp).Row + 1)
Sheets("blad4").Range("A1").CurrentRegion.Copy Destination:=Sheets("blad1").Range("A" & Cells(Rows.Count, "A").End(xlUp).Row + 1)
End Sub

blad1 -blad2 - blad3 - en blad4 moet je jouw namen geven

Niels

 

[Fenadna]

Het werkt! Super! Nog 2 problemen:
- de eerste regel met de kolomnamen komt in rij 2 ipv rij 1.
- 1 kolom van de 3 samengevoegde tabbladen bevat een formule die de waarde nul geeft als de kolom ernaast leeg is, maar in het samengevoegde tabblad krijg ik daardoor lege regels waar deze formule staat. In de draaitabel die ik van dit tabblad maakt stopt bij de lege regels.

Is aan bovenstaande nog iets te doen?

 

[Niels28]

bereiken en bladnamen zelf aanpassen

Sub test()
Sheets("blad2").Range("A2:B" & Sheets("blad2").Cells(Rows.Count, "A").End(xlUp).Row).Copy Destination:=Sheets("blad1").Range("A" & Cells(Rows.Count, "A").End(xlUp).Row + 1)
Sheets("blad3").Range("A2:B" & Sheets("blad3").Cells(Rows.Count, "A").End(xlUp).Row).Copy Destination:=Sheets("blad1").Range("A" & Cells(Rows.Count, "A").End(xlUp).Row + 1)
Sheets("blad4").Range("A2:B" & Sheets("blad4").Cells(Rows.Count, "A").End(xlUp).Row).Copy Destination:=Sheets("blad1").Range("A" & Cells(Rows.Count, "A").End(xlUp).Row + 1)
End Sub

voor formuleprobleem nogmaals een voorbeeld bestandje zo wel makkelijk zijn, je komt steeds met nieuwe info.

Niels

 

[Fenadna]

Het bestand is 23MB en er staan gegevens in die ik liever niet op internet zet.

Het probleem met de oplossing die je voorstelt is dat hierdoor het bereik niet meer variabel is, wanneer ik nieuwe gegevens inlees in de 3 tabbladen kan het aantal rijen veranderen.

 

[Niels28]

Het bereik is wel variabel in het aantal rijen.
Er staat range("A2:B" & laatse ingevulde rij)

ik hoef ook niet heel je bestand te zien maar alleen een voorbeeld bestand met de 4 tabbladen waar het over gaat met fictieve waarde die overeenkomen met de originele waarde.
Dus de formule ed.

Als je de formule niet mee wilt kopieren maar alleen de waardes kan het zo:

Sub test()
With Sheets("blad1")
    With Sheets("blad2")
        .Range("A2:B" & .Cells(Rows.Count, "A").End(xlUp).Row).Copy
    End With
    .Range("A" & Cells(Rows.Count, "A").End(xlUp).Row + 1).PasteSpecial (xlValues)
    With Sheets("blad3")
        .Range("A2:B" & .Cells(Rows.Count, "A").End(xlUp).Row).Copy
    End With
    .Range("A" & Cells(Rows.Count, "A").End(xlUp).Row + 1).PasteSpecial (xlValues)
    With Sheets("blad4")
        .Range("A2:B" & .Cells(Rows.Count, "A").End(xlUp).Row).Copy
    End With
    .Range("A" & Cells(Rows.Count, "A").End(xlUp).Row + 1).PasteSpecial (xlValues)
End With
Application.CutCopyMode = False
End Sub

Niels

 

[Fenadna]

Hij doet het!
Heeel erg bedankt!