• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Tabbladen samenvoegen

Status
Niet open voor verdere reacties.

Wim1961

Gebruiker
Lid geworden
23 jun 2007
Berichten
29
Goedenmorgen,

ik heb het forum reeds doorzocht maar kan geen goed antwoord vinden. Als het er toch staat zie ik graag de link naar het onderwerp verschijnen. Ondertussen stel ik de onderstaande vraag.

Ik heb een MS Excell bestand met daarin 17 tabbladen. Elk tabblad heeft twee kolommmen met data. Nu zou ik graag van alle 17 (kan soms ook meer/minder zijn) tabbladen de data willen kopieeren en onder elkaar in een nieuw tabblad plaatsen.
Vooralsnog heb ik dit handmatig gedaan maar het lijkt erop dat dit een klusje wordt dat regelmatig terug gaat komen dus als het automatisch kan zou ik hier erg mee geholpen zijn.

Wim
 
Wim 1961, Het is zeker al vaker voorgekomen. Maar omdat ik sneller een stukkie code schrijf dan zoek, doe ik 't eerste maar....
Code:
Sub TotaalBlad()

    Worksheets.Add before:=Sheets(1)
    Sheets(1).Name = "TOTAAL"
    
    For i = 2 To Sheets.Count
        With Sheets(i)
            .Range("A1:B" & .Range("A" & Cells.Rows.Count).End(xlUp).Row).Copy _
                Sheets(1).Range(Cells(Rows.Count, 1).End(xlUp).Address)
        End With
    Next i

End Sub
Ik ben er vanuit gegaan dat de genoemde "2 kolommen', kolom A en B zijn. Van iedere sheet wordt óók de header meegenomen. Als je dat niet wilt moet je de 1 in de regel Range("A1:B" & .Rang.. veranderen in een 2.

Groet, Leo
 
Hoi Leo,
dit werkt perfect:)
Héél erg bedankt voor de hulp, dit scheelt een boel kopieëer en plakwerk
en bovendien daardoor véél minder kans op een muisarm.

groeten, Wim
 
Wim 1961, In de snelheid toch nog een klein foutje...:(
Bij het plakken, werd het copie over de laatste regel van de reeds aanwezige regels geplakt. Hierbij de correctie!
Code:
Sub TotaalBlad()

    Worksheets.Add before:=Sheets(1)
    Sheets(1).Name = "TOTAAL"
    
    For i = 2 To Sheets.Count
        With Sheets(i)
            .Range("A1:B" & .Range("A" & Cells.Rows.Count).End(xlUp).Row).Copy _
                Sheets(1).Range(Cells(Rows.Count, 1).End(xlUp[COLOR="Blue"]).Offset(IIf(Sheets(i).Index = 2, 0, 1)).[/COLOR]Address)
        End With
    Next i

End Sub

Groet, Leo
 
Laatst bewerkt:
Hoi Leo,

bedankt voor de update, ik had de regels nog niet geteld maar bij controle
nu zag ik wel dat het er minder waren. Gelukkig ook weer opgelost. Bedankt
voor je hulpvaardigheid.

groeten, Wim
 
Goedenmiddag Leo,

ik heb nog één vraag. Het automatisch kopieeren en plakken van de
tabbladen gaat perfect nu. Is het ook mogelijk om automatisch vijf
regels met kruisjes (XXXXXXXXXXXXXXXXXXXXX) weg te schrijven tussen
de gekopieerde tabladen in? Zoals bijvoorbeeld hieronder

tablad1,tekst tekst
tablad1,tekst tekst
tablad1,tekst tekst
tablad1,tekst tekst
tablad1,tekst tekst
XXXXXX,XXXXXXXXX
XXXXXX,XXXXXXXXX
XXXXXX,XXXXXXXXX
XXXXXX,XXXXXXXXX
XXXXXX,XXXXXXXXX
tablad2,tekst tekst
tablad2,tekst tekst
tablad2,tekst tekst
tablad2,tekst tekst
tablad2,tekst tekst
tablad2,tekst tekst
tablad2,tekst tekst
tablad2,tekst tekst
tablad2,tekst tekst

enz, enz, enz,

groeten, Wim
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan