[Excel] Meerdere bestanden samenvoegen

[Verwijderd]

Ik heb in ongeveer 50 Excel bestanden die ik wil samenvoegen tot 1 groot bestand. Is er een snellere manier dan heel erg veel copy pasten?

Zo ja, wat dan? Bestanden staan allemaal in dezelfde dir, zou een macro die allemaal kunnen samenvoegen? Zo ja, hoe schrijf je zo'n macro.

Ik weet vrij weinig van excel en de search levert ook weinig nuttigs op.

Kortom: Help!

[KingRichard]

Nou, vooruit dan maar. De code die een dir uitleest heb ik nu al zo vaak gepost dat 'ie wel in de FAQ mag.

Visual Basic:

Sub VoegExcelBestandenSamen()
' [TOPIC=848630///][NOHTML][rml][ Excel] Meerdere bestanden samenvoegen[/rml][/NOHTML][/TOPIC]

Dim wbSingleWorkbook, wbFinalWorkbook           As Excel.Workbook
Dim wsSheet                                     As Excel.Worksheet
Dim strPath, strWorkbook(100)                   As String
Dim intCounter, n                               As Integer
    
    strPath = "c:\test\"        ' Map met .xls-bestanden
    
    intCounter = 1              ' teller
    
    strWorkbook(intCounter) = Dir(strPath & "*.xls")
    
    Do While strWorkbook(intCounter) <> ""
    
        intCounter = intCounter + 1
        strWorkbook(intCounter) = Dir
        
    Loop
    
    intCounter = intCounter - 1 ' want de laatste is leeg
    
    Set wbFinalWorkbook = Workbooks.Add
    
        
    For n = 1 To intCounter
    
        Set wbSingleWorkbook = Workbooks.Open(Filename:=strPath _
            & strWorkbook(n), ReadOnly:=True)
            
        For Each wsSheet In wbSingleWorkbook.Sheets
        
            wsSheet.Copy after:=wbFinalWorkbook.Sheets(wbFinalWorkbook.Sheets.Count)
            wbFinalWorkbook.Sheets(wbFinalWorkbook.Sheets.Count).Name = strWorkbook(n) _
             & "|" & wsSheet.Name
            
        Next wsSheet
        wbSingleWorkbook.Close
    
    Next n
    
    Application.DisplayAlerts = False
    wbFinalWorkbook.Sheets(1).Delete
    wbFinalWorkbook.Sheets(2).Delete
    wbFinalWorkbook.Sheets(3).Delete
    Application.DisplayAlerts = True
    
    Set wbSingleWorkbook = Nothing

End Sub

Heb je hier iets aan?

[ Voor 4% gewijzigd door KingRichard op 15-12-2003 14:35 . Reden: "die codeblokken vernaggelen je opmaak zo, vind je ook niet?" ]

[Verwijderd]

Ik krijg een foutmelding bij het importeren.

code:

wbFinalWorkbook.Sheets(wbFinalWorkbook.Sheets.Count).Name = strWorkbook(n) _
             & "|" & wsSheet.Name

schijnt fout te zijn. Ik ganu even met de code rommelen om het voor elkaar te krijgen. Hulp is altijd welkom

[KingRichard]

Hmmm... Misschien zit er een beperking aan de lengte van namen voor Sheets en heb je in de originele bestanden héééle lange gebruikt? Het kan ook zijn dat de bestandsnamen van de originelen tekens bevatten die niet in een Sheetnaam mogen.
Wat is precies de foutmelding? Gebeurt het bij het eerste Excelbestand of later?

[Verwijderd]

Ow kee.. het was dus een te lange naam. Max 31 tekens..

Maar hij doet het nu in ieder geval! Bedankt, scheelt me behoorlijk wat werk dit

[Hennio]

OK, ik weet dat het al een oud draadje is, maar ik heb er een vraag over.

Deze macro (complimenten trouwens) copieerd alle bestanden/sheets naar 1 bestand met meerdere sheets.

Ik zou graag willen dat hij hem copieert naar 1 bestand in 1 sheet, dus alles onder elkaar....

Het is mij niet gelukt hem op die manier om te bouwen, kan iemand mij op weg helpen ?

Alvast bedankt...

[onkl]

Kijk eens naar worksheet.UsedRange. Dat omvat alle cellen die je in je originele blad gebruikt vermoed ik.
Geeft een Range object terug, die kan je copy pasten en heeft ook een .Rows eigenschap.
Effe prutsen met de plek waar je in moet plakken en je bent een eind verder.
BTW, bouw een controle in je macro op het maximum van 65536 regels in je doelwerkblad. Is waarschijnlijk beter.
BTW2: Probeer vooral pastespecial, tekst. Je formules gaan dit niet leuk vinden.

[ Voor 33% gewijzigd door onkl op 30-11-2004 16:32 . Reden: Nog wat additionele ideeetjes ]

[KingRichard]

Nou, vooruit dan maar. De code die een dir uitleest heb ik nu al zo vaak gepost dat 'ie wel in de FAQ mag.

Visual Basic:

Sub VoegExcelBestandenSamenIn1NieuwBlad()
' [TOPIC=848630///][NOHTML][rml][ Excel] Meerdere bestanden samenvoegen[/rml][/NOHTML][/TOPIC]
' deel 2

Dim wbSingleWorkbook As Excel.Workbook, wbFinalWorkbook As Excel.Workbook
Dim wsSingleSheet As Excel.Worksheet, wsFinalSheet As Excel.Worksheet
Dim strPath As String, strWorkbook(500) As String ' max 500 bestanden
Dim intCounter As Integer, n As Integer
Dim Answer As VbMsgBoxResult

    strPath = "c:\test\"        ' Map met .xls-bestanden
    intCounter = 1              ' teller
    strWorkbook(intCounter) = Dir(strPath & "*.xls")
    
    Do While strWorkbook(intCounter) <> ""
    
        intCounter = intCounter + 1
        strWorkbook(intCounter) = Dir
        
    Loop
    
    intCounter = intCounter - 1 ' want de laatste is leeg
    Set wbFinalWorkbook = Workbooks.Add
    Application.DisplayAlerts = False
    
    Do While wbFinalWorkbook.Sheets.Count > 1
    
        wbFinalWorkbook.Sheets(1).Delete
    
    Loop                        ' We hebben maar 1 blad nodig
    
    Application.DisplayAlerts = True
    Set wsFinalSheet = wbFinalWorkbook.Sheets(1)
        
    On Error GoTo Einde         ' Error trapping AAN
    
    For n = 1 To intCounter
    
        Set wbSingleWorkbook = Workbooks.Open(Filename:=strPath _
            & strWorkbook(n), ReadOnly:=True)
            
        For Each wsSingleSheet In wbSingleWorkbook.Sheets
            
            wsSingleSheet.UsedRange.Copy _
                Destination:=wsFinalSheet.Cells _
                (wsFinalSheet.Cells.SpecialCells _
                (xlCellTypeLastCell).Row + 1, 1)
            
        Next wsSingleSheet

        wbSingleWorkbook.Close
    
    Next n
    
    On Error GoTo 0             ' Error trapping UIT
    
Einde:

    Select Case Err.Number      ' Foutmelding 1004 is
                                ' hoogstwaarschijnlijk veroorzaakt
        Case 1004               ' door iets te plakken dat boven
                                ' de 65536 rijen uit zou komen
            Answer = MsgBox(Err.Description & Chr(13) & Chr(13) & _
                "Waarschijnlijk wordt dit bestand te groot..." & _
                Chr(13) & "Verder gaan op nieuw blad?", _
                vbCritical Or vbYesNo, "Error " & Err.Number & _
                ": " & Err.Description)
            
            If Answer = vbYes Then
            
                Set wsFinalSheet = wbFinalWorkbook.Sheets.Add
                Resume
                
            End If
            
        Case 0                  ' Niks aan 't handje :-)
            
        Case Else               ' Overige foutmeldingen
        
            MsgBox Err.Description, _
                vbCritical Or vbOKOnly, "Error " & Err.Number & _
                " in bestand " & n
    
    End Select
    
    Set wbSingleWorkbook = Nothing
    Set wbFinalWorkbook = Nothing
    Set wsSingleSheet = Nothing
    Set wsFinalSheet = Nothing

End Sub

Heb je hier iets aan?

[ Voor 25% gewijzigd door KingRichard op 01-12-2004 22:40 . Reden: "die codeblokken vernaggelen je opmaak zo, vind je ook niet?" | regel 80: 'And' veranderd in 'Or' en nog wat kleine aanpassingen... ]

[Hennio]

Fantastisch!

Ik maak zelden mee dat een door een ander geschreven macro ook in 1 keer werkt zoals ik zelf zou willen, deze dus wel.

Hulde aan King Richard!

[sanfranjake]

Hennio schreef op woensdag 01 december 2004 @ 08:12:
Fantastisch!

Ik maak zelden mee dat een door een ander geschreven macro ook in 1 keer werkt zoals ik zelf zou willen, deze dus wel.

Hulde aan King Richard!

Je zou mijn inziens wel iets vriendelijker mogen zijn over de door de posters boven je aangegeven oplossingen. We zijn hier tenslotte allemaal vrijwillig, en helpen je voor ons plezier

[Hennio]

sanfranjake schreef op woensdag 01 december 2004 @ 09:24:
[...]

Je zou mijn inziens wel iets vriendelijker mogen zijn over de door de posters boven je aangegeven oplossingen. We zijn hier tenslotte allemaal vrijwillig, en helpen je voor ons plezier

Sorry dat het zo misschien overkomt, dat bedoel ik er niet mee.

Ik wilde aangeven dat ik heel erg blij ben met de macro van King Richard, omdat ik er niets meer aan hoefde te veranderen.

Uiteraard wil ik onkl ook bedanken voor zijn reaktie

[onkl]

* onkl heeft toch al een veel te groot ego

Code van King Richard is niet alleen functioneel, maar ook erg netjes, duidelijk netter dan mijn oplossingsrichting.
* onkl diep jaloers

[Verwijderd]

Ik heb nog enkele vragen of dit onderwerp.

Map X bevat 10 excel bestanden met meerdere tabbladen.
Het zijn allemaal dezelfde bestanden met dezelfde lay-out.
Ik wil dat alles samengevoegd wordt van tabblad x bij alle bestanden vanaf de 2e regel. Wat moet ik in de code aanpassen?
Als het mogelijk is ook nog geplakt wordt in de 2e rij van het bestand waar de macro in is opgeslagen. Wat moet ik in de code aanpassen?

Ik hoop dat iemand uitkomst kan bieden.

Alvast dank!

[F_J_K]

Wat moet ik in de code aanpassen?

De boel wordt al redelijk in je schoot geworpen. Wat zijn je eigen gedachten en opties? KingRichard is wel heel erg aardig geweest maar dat is geen reden om niet zelf aan de gang te gaan

---

27 nov 2008: ik heb de ongerelateerde kick van een jaar naar een eigen topic verplaatst zodat men niet in de war raakt, zie [Excel] Kolombreedte aanpassen *

[ Voor 29% gewijzigd door F_J_K op 27-11-2008 15:13 ]

[Verwijderd]

Ik gebruik bovenstaande macro ook, maar is het ook mogelijk om alleen bepaalde tabbladen te kopieren uit de losse excelbestanden?

[Verwijderd]

ik heb bovenstaande oplossing niet erg grondig bekeken, maar het volstaat volgende lus

Visual Basic:

 For Each wsSingleSheet In wbSingleWorkbook.Sheets
            
            wsSingleSheet.UsedRange.Copy _
                Destination:=wsFinalSheet.Cells _
                (wsFinalSheet.Cells.SpecialCells _
                (xlCellTypeLastCell).Row + 1, 1)
            
        Next wsSingleSheet

te vervangen door

Visual Basic:

wbSingleWorkbook.workSheets(1).UsedRange.Copy _
                Destination:=wsFinalSheet.Cells _
                (wsFinalSheet.Cells.SpecialCells _
                (xlCellTypeLastCell).Row + 1, 1)

workSheets(1) vervangen door de juiste index of door de naam (worksheets("tekopierentabblad"))

[Verwijderd]

Bedankt voor de snelle reactie, maar ik had de bovenste macro gebruikt en daarin staat dat stuk niet. Mijn VB-kennis is niet zo heel groot, het is dus ook niet gelukt om hem zelf zo te implementeren dat hij daarin werkt. Kan je me hiermee nog een keer helpen?

Bedankt!

[Verwijderd]

in dat geval was mijn suggestie helemaal niet bruikbaar. dus even voor alle duidelijkheid : jij wil uit alle werkmappen in een bepaalde directory een welbepaalde worksheet overbrengen naar een "overzichtsmap"?
vervang dan deze code uit de eerste macro in deze draad

Visual Basic:

For Each wsSheet In wbSingleWorkbook.Sheets
        
            wsSheet.Copy after:=wbFinalWorkbook.Sheets(wbFinalWorkbook.Sheets.Count)
            wbFinalWorkbook.Sheets(wbFinalWorkbook.Sheets.Count).Name = strWorkbook(n) _
             & "|" & wsSheet.Name
            
        Next wsSheet 

door onderstaand (niet getest)

Visual Basic:

wbSingleWorkbook.Sheets("naamtekopierensheet").Copy _
             after:=wbFinalWorkbook.Sheets(wbFinalWorkbook.Sheets.Count)
wbFinalWorkbook.Sheets(wbFinalWorkbook.Sheets.Count).Name = strWorkbook(n) _
             & "|" & wbSingleWorkbook.Sheets("naamtekopierensheet").Name

[Verwijderd]

Beetje oude vraag, maar bij mij werkt ie nu ook. (was er niet vanaf het begin van de vraagstelling mee bezig hoor!)
Maar ben eigenlijk op zoek naar een macro die de gegevens van het tabblad van meerdere bestanden onderelkaar zet, waarna ik een draaitabel kan maken. (voor het optellen van dezelfde artikelnumers)

Ik hoor graag of jullie me kunnen helpen.

Met vriendelijke groet!

[Lustucru]

Beetje oude vraag? Het draadje gaat al 13 jaar mee!

Anyway, hierboven staat exact aangegeven hoe je dat moet doen, dus wat is het probleem?

[Verwijderd]

Inmiddels alweer wat gekloot en nu een stukje verder.
Bij mij werkte het niet zoals ik het wilde (uiteraard ieder z'n eigen intrepretatie).
Ik kreeg eerst een melding dat het bestand te groot werd, de foutmelding 1004.
Toen heb ik ingesteld dat ik een aantal rows kopieer, echter niet alle bestanden hebben dezelfde aantal rows, dus ben nu nog de lege regels er tussen aan het verwijderen.

wsSingleSheet.Rows("8:1000").Copy _
Destination:=wsFinalSheet.Cells _
(wsFinalSheet.Cells.SpecialCells _
(xlCellTypeLastCell).Row + 1, 1)

Het plakken gaat mij nog niet lukken, dat de nieuwe gegevens vanaf de eerste vrije regel van het eerdere bestand (rows+1) geplakt gaan worden.

Als iemand een oplossing heeft, dan hoor ik het graag uiteraard. Thx alvast.
Zelf ga ik ook nog ef knommele

---

ah, snap nu waarom de fout zich voordoet, oude versie naar nieuwe versie, dus van 65536 rows naar 1048576.
Daarom werkt (volgens mij) de UsedRange niet naar behoren.

[ Voor 9% gewijzigd door Verwijderd op 15-06-2016 10:27 ]

[Verwijderd]

Graag help bij het volgende:

bovenstaande macro werkt wel, maar (natuurlijk) niet zoals ik het graag gewild had.

Uitleg:
ik wil een aantal bestanden selecteren in een map.
in elk bestand staat een blad met informatie welke ik wil copieren vanaf rij 8 (aantal rijen is variabel)
Dit moet gekopieerd worden in een verzamelbestand onder elkaar (eerste vrije rij)

Ik heb UsedRange wel werkend, echter pakt hij alle informatie op dat blad.
ik wil echter maar een bepaald aantal rijen kopieren vanaf rij 8.

Als iemand me hierbij kan helpen, hoor ik dat natuurlijk graag!

[Verwijderd]

@KingRichard dinsdag 30 november 2004 23:23

Ik mis een statement 'Exit Sub' tussen de regel 'On Error GoTo 0' en de regel 'Einde:'.

[Verwijderd]

Dit artikel kan hier handig zijn - https://www.extendoffice....e-multiple-workbooks.html

Bedankt

[Lustucru]

Verwijderd schreef op woensdag 22 februari 2017 @ 18:35:
@KingRichard dinsdag 30 november 2004 23:23

Ik mis een statement 'Exit Sub' tussen de regel 'On Error GoTo 0' en de regel 'Einde:'.

Ik mis vooral het benul dat dit 13 jaar later een tamelijk nodeloze toevoeging is. en bovendien niet eens waar: daar hoort nergens een exit sub.