• 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.

Werkbladen uit 1 map samenvoegen met macro

Status
Niet open voor verdere reacties.
S

ScriptGys

Gebruiker
Lid geworden
3 nov 2006
Berichten
44
Hallo helpmij-ers,

Ik heb de volgende vraag.
Ik heb een map met daarin ongeveer 80 excel bestanden.
In al deze bestanden zit een tabblad genaamd "Herschikking".

Nu is mijn bedoeling het volgende.
Ik maak een nieuw excelbestand aan. In dat excel bestand zet ik een macro die de hele map met excel bestanden gaat doorzoeken en vervolgens alle tabbladen herschikking samenvoegd in het nieuwe bestand.
Met samenvoegen bedoel ik dan uiteraard alle gegevens onder elkaar zetten.

Ik ben zelf al druk aan het Googlen geweest en heb ook veel gezocht op Helpmij.nl maar ik kom er niet uit.

Is het wel mogelijk wat ik wil?

Alvast bedankt voor jullie zeer gewaardeerde hulp!

Greetz, PHPFreak.
 
Gebruik deze macro in een leeg Excel document.
Pas de padnaam aan

Code: 
Sub samenvoeg()
  for each fl in createobject("scripting.filesystemobject").getfolder("[COLOR="Teal"][B]E:\bestanden[/B][/COLOR]").files
    if right(fl.name,4)=".xls" then 
       with workbooks.add(fl)
          sq=.sheets("Herschikking").usedrange
          .close false
       end with
       This[COLOR="Red"]workbook[/COLOR].sheets(1).cells(rows.count,1).end(xlup).offset(1).resize(ubound(sq),ubound(sq,2))=sq
    end if
  next
End Sub
 
Laatst bewerkt:
Hartelijk dank voor het snelle antwoord.

Ik heb het direct getest. De macro zocht naar .xls bestanden hier heb ik .xlsx van gemaakt. De 4 van de extentie verandert in 5.
Nu heb ik hem dus als volgt:

Code: 
Sub Samenvoeging()

  For Each fl In CreateObject("scripting.filesystemobject").getfolder("U:\XLS\Samenvoegingen").Files
    If Right(fl.Name, 5) = ".xlsx" Then
       With Workbooks.Add(fl)
          sq = .Sheets("Herschikking").UsedRange
          .Close False
       End With
       Thisdocument.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(sq), UBound(sq, 2)) = sq
    End If
  Next
End Sub
Enkel geeft hij de foutmelding "Fout 9 tijdens uitvoering. Het subscript valt buiten het bereik". Hierbij geeft hij de volgende regel aan.
Code: 
sq = .Sheets("Herschikking").UsedRange

Doe ik iets fout?
 
Zoek ik ook

Ik ben ook al tijden op zoek naar een macro die precies doet wat jij ook wilt. Ook ik wil gegevens uit een specifiek tabblad van groot aantal bestanden samenvoegen naar 1 tabblad in een nieuw bestand.
Ik heb in het forum van Worksheet.nl deze topic gevonden: http://www.worksheet.nl/forumexcel/showthread.php?t=60336. Met wat aanpassingen doet die wel wat ik wil. Misschien heb jij er ook iets aan?

:)
 
@snb

@SNB

Ik heb jouw macro ook geprobeerd omdat ik ook zoiets al een hele tijd zoek. Ik kom iets verder dan de vragensteller, maar ik loop vast op
Code: 
Thisdocument.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(sq), UBound(sq, 2)) = sq
Ik krijg foutmelding: Fout 424 tijdens uitvoering - Object vereist.

Eigenlijk zoek ik een macro die vanuit gesloten bestanden gegevens van een specifiek tabblad haalt en verzamelt naar een nieuw bestand.
Mijn situatie is als volgt:
Ik heb in een directory plm 30 bestanden, die elk weer bestaan uit 55 tabbladen. Die tabbladen bevatten allemaal gegevens van een week in het jaar. Nu wil ik in een nieuw bestand alle gegevens van bijv. week 28 verzamelen. Ik heb wel een macro gevonden die dat kan, maar dan worden alle bestanden eerst geopend en dat duurt erg lang omdat het nogal grote bestanden zijn. Ik wil het dus graag doen zonder eerst al die 30 bestanden te hoeven openen. Heb jij misschien een idee of dat kan en zo ja hoe?
 
Enkel geeft hij de foutmelding "Fout 9 tijdens uitvoering. Het subscript valt buiten het bereik". Hierbij geeft hij de volgende regel aan.

Code:
sq = .Sheets("Herschikking").UsedRange
Klik om te vergroten...

Dat betekent, dat dit Excel-bestand geen werkblad "Herschikking" bevat.
Het is het slimste als je alle bestanden die je wil samenvoegen (en dus wel zo'n werkblad bevatten) in 1 aparte directory zet.
Dan is de test
If Right(fl.Name, 5) = ".xlsx"
ook niet meer nodig.
 
@DCW...

Uit een gesloten bestand kun je niets lezen.
Je kunt bestanden wel op de achtergrond uitlezen

Code: 
Sub samenvoeg()
  application.screenupdating =false
  for each fl in createobject("scripting.filesystemobject").getfolder("E:\bestanden").files
     with getobject(fl)
        sq=.sheets("Herschikking").usedrange
        .close false
     end with
     [COLOR="Red"]Thisworkbook[/COLOR].sheets(1).cells(rows.count,1).end(xlup).offset(1).resize(ubound(sq),ubound(sq,2))=sq
    end if
  next
  application.screenupdating=true
End Sub
Een alternatief is het gebruik van databasequeries.
 
@ SNB

Sorry voor mijn late reactie maar het is gelukt met de macro uit je laatste post. TOP!!!!

@ DCWDPT
Die laatste Macro werkt ook uit gesloten bestanden. Zolang je totaalblad waarin alle gegevens samengevoegd moeten worden maar openstaat.


Nu wil ik zelf nog iets verder gaan. Ik zoek nu nog een Macro die het volgende doet.
Als er geen waarde is ingevoerd in de kolom L moet deze hele regel verwijderd worden.
Deze macro moet dus eingelijk door alle regels heen lopen.
Het allermooiste zou zijn als ik dat kan combinenren met de macro samenvoeg.

Alvast bedankt voor jullie verdere hulp!
 
Code: 
Sub samenvoeg()
  application.screenupdating =false
  for each fl in createobject("scripting.filesystemobject").getfolder("E:\bestanden").files
     with getobject(fl)
 [COLOR="Blue"]       .sheets("Herschikking").columns(12).specialcells(4).entirerow.delete[/COLOR]
        sq=.sheets("Herschikking").usedrange
        .close false
     end with
     Thisworkbook.sheets(1).cells(rows.count,1).end(xlup).offset(1).resize(ubound(sq),ubound(sq,2))=sq
    end if
  next
  application.screenupdating=true
End Sub
 
Welke macro?

PHPFreak,

Je schrijft in je laatste post: 'Die laatste Macro werkt ook uit gesloten bestanden. Zolang je totaalblad waarin alle gegevens samengevoegd moeten worden maar openstaat.'
Ik ben de weg een beetje kwijt. Welke macro bedoel je dan precies? Zou je aub de code kunnen posten zodat ik 'm kan kopiëren en uitproberen?
Bedankt alvast.

:thumb:
 
@DCWDPT

Ik bedoel deze macro.
Code: 
Sub samenvoeg()
  application.screenupdating =false
  for each fl in createobject("scripting.filesystemobject").getfolder("E:\bestanden").files
     with getobject(fl)
        sq=.sheets("Herschikking").usedrange
        .close false
     end with
     Thisworkbook.sheets(1).cells(rows.count,1).end(xlup).offset(1).resize(ubound(sq),ubound(sq,2))=sq
    end if
  next
  application.screenupdating=true
End Sub

Hiervoor hoeft alleen het doelwerkblad open te staan. De gegevens leest hij op de achtergrond uit.

@snb

het is helemaal gelukt. Hartelijk dank voor je hulp!
 
Laatst bewerkt:
Niet echt vanuit ongeopende bestanden

PHPFreak,

bij deze macro worden de bronbestanden wel degelijk allemaal geopend. Je ziet het alleen niet omdat de screenupdating uitgezet is. Dit is dus niet wat ik bedoelde toen ik vroeg of je vanuit gesloten bestanden iets kunt verzamelen. Ik denk dat het gewoon niet kan wat ik wil. Daar moet ik me maar bij neerleggen. Ik zoek dus wel een andere oplossing voor mijn probleem.
In elk geval hartelijk dank voor het meedenken en jouw reacties. :thumb:
 
Beste DCWDPT,

Ik heb wel eens wat gelezen over een "Pull" functie die gegevens uit een gesloten bestand kan halen.
Zelf zoek ik ook nog zoiets, maar ben er nog niet achter of het het om een invoegtoepassing gaat of een stukje code.

groetjes,

Rob
 
Sorry dat ik deze post nog een keer naar boven haal. Ik ben nog steeds aan het stoeien met Macro's.

Nu heb ik nog een kleine vraag waar ik zelf niet uit kom.
Ik gebruik de volgende Macro om regels uit bestanden samen te voegen
Code: 
Sub samenvoeg()
  Application.ScreenUpdating = False
  For Each fl In CreateObject("scripting.filesystemobject").getfolder("D:\test").Files
     With GetObject(fl)
        .Sheets("Herschikking").Columns(12).SpecialCells(4).EntireRow.Delete
        sq = .Sheets("Herschikking").UsedRange
        .Close False
     End With
     ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(sq), UBound(sq, 2)) = sq
  Next
  Application.ScreenUpdating = True
End Sub

Alle bronbestanden hebben dezelfde opmaak.
Nu wil ik enkele regels uit het brondbestand uitsluiten zodat deze niet worden gekopierd. Is dit mogelijk en kan iemand een voorbeeld geven?

Ook gebeurd er iets vreemds als ik de lege regels wil verwijderen. Hij verwijderd de eerste keer nog niet alle regels. Ik moet de Macro enkele keren uitvoeren voordat ook echt alle regels verwijderd worden.

Alvast hartelijk dank voor jullie hulp!
 
Laatst bewerkt:
Beste PHPFreak, het beste is om een nieuwe vraag te starten, aangezien deze al op opgelost staat zal de respons minder groot zijn. Op basis van welke criteria wil je die regels uitsluiten ? Het kan eventueel met een filter, een woord, een cijfer oid in een bepaalde kolom, enz..
 
Toch nog een poging in deze thread;)

Ik wil het graag uitsluiten op basis van regelnummer.
Nog mooier is het als ik woorden in kolomA EN regelnummers op kan geven maar dat wordt waarschijnlijk lastig?
 
Het is toch veel eenvoudiger (en sneller) uit het samengevoegde bestand regels te verwijderen ?

Code: 
Sub samenvoeg()
  Application.ScreenUpdating = False
  For Each fl In CreateObject("scripting.filesystemobject").getfolder("D:\test").Files
     With workbooks.add(fl)
         .Sheets("Herschikking").UsedRange.copy ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        .Close False
     End With
  Next
  With ThisWorkbook.Sheets(1)
     .Columns(12).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
     With .Columns(1)
         .Replace "soort", "",xlwhole
         .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
     End With
  End With
  Application.ScreenUpdating = True
End Sub
 
Laatst bewerkt:
@SNB

Ik snap niet helemaal wat je bedoelt. Kun je mij dit simpel uitleggen?

Misschien moet mijn vraag ook iets duidelijker.

De totale macro wil ik graag als volgt.

Voeg de tabbladen "Herschikking" van alle bestanden in "D:\test" samen in 1 document
Verwijder vervolgens alle regels in dat ene document waar in de kolom "L" niets is ingevoerd.
Verwijder vervolgens ook de regels die voldoen aan de criteria dat in kolom "A" de tekst "soort" staat.

Hopelijk is het nu wat duidelijker wat is precies wil bereiken.

Ik kreeg trouwens bij de macro uit je vorige post een syntax-fout op deze regel: With workbooks.add fl

Alvast heel erg hartelijk dank voor je hulp!
 
PHPFreak zei:
Ik kreeg trouwens bij de macro uit je vorige post een syntax-fout op deze regel: With workbooks.add fl
Klik om te vergroten...

Zet haakjes rond fl en geen spatie ertussen.

PHPFreak zei:
Verwijder vervolgens alle regels in dat ene document waar in de kolom "L" niets is ingevoerd.
Klik om te vergroten...

Na de lus doorheen de bestanden zet je:

Code: 
ThisWorkbook.Sheets(1).Columns(12).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

PHPFreak zei:
Verwijder vervolgens ook de regels die voldoen aan de criteria dat in kolom "A" de tekst "soort" staat.
Klik om te vergroten...

Code: 
sq.Columns(1).Replace "soort", "", xlWhole
sq.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Wigi
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan