gratis drank!


/fps

dat werkt het makkelijkste in visual basic (wat zit ingebouwd in office), google

Sub Merge2MultiSheets()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim MyPath As String
Dim strFilename As String

Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
MyPath = "C:\MyPath" ' change to suit
Set wbDst = Workbooks.Add(xlWBATWorksheet)
strFilename = Dir(MyPath & "\*.xls", vbNormal)

If Len(strFilename) = 0 Then Exit Sub

Do Until strFilename = ""

Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename)

Set wsSrc = wbSrc.Worksheets(1)

wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)

wbSrc.Close False

strFilename = Dir()

Loop
wbDst.Worksheets(1).Delete

Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

ik heb zo'n visual basic ding geopend in excel en de code geplakt (en het pad aangepast, verder hoef ik niks te veranderen toch?) en er lijkt wat te gebeuren. Cool!

Ik krijg nog een foutmelding, maar volgens mij snap ik waar dat aan ligt.

Nu even slapen want het is het hier 6 uur vroeger. Straks laat ik even weten hoe het verder gegaan is.

Dit kopieert alle worksheets naar één nieuwe. Op zich zou het redelijk makkelijk moeten zijn om na het kopieren een extra rij in te voegen en daar de bestandsnaam in te zetten. Na
wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)

zet je dan iets van
wbDst.Worksheets(wbDst.Worksheets(wbDst.Worksheets.Count)+1).Cells("A1").insertRow
Cell(A1). Value=strFilename

Dit werkt niet maar op deze manier zou het moeten werken....

Uitprinten en een nietje erdoor

Retecool bestaat uit kneuzen.

hoe gaat het stoppen met roken, Fantje?

O, is Fantje ook gestopt dan?

Toen ik op dag twee zat, was zij al in week drie maar wel een keer gezondigd.

Godver, dat ding werkt nu, maar zet het op allemaal verschillende werkbladen en ik wil het gewoon op 1 werkblad hebben!


Op zich goed, maar wel ongelooflijke zin in een peuk, het duurt nog wel even voordat ik een niet-roker ben in plaats van een niet-rokende roker...

Is dit wat?
http://www.vbaexpress.com/kb/getarticle.php?kb_id=151

Ja, nu heb ik een werkblad met alles samen! Nu alleen nog die fucking file namen (of nu dus werkbladnamen) erbij zien te krijgen!

Dank je, Kets. Virtueel is beter dan niks.

Even een paar minuutjes gespeeld, verandert ook je sheetnaam naar de bestandsnaam.... Have fun....

Sub samen2()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim MyPath As String
Dim strFilename As String

Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
MyPath = "C:\test" ' directory met excelbestanden
Set wbDst = Workbooks.Add(xlWBATWorksheet)
strFilename = Dir(MyPath & "\*.xls", vbNormal)

If Len(strFilename) = 0 Then Exit Sub

Do Until strFilename = ""

Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename)

' op welk blad in het bestand staat de data?
Set wsSrc = wbSrc.Worksheets("Blad3")

' toevoegen
wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)

' naam van worksheet wijzigen in bestandsnaam van orgineel bestand
wbDst.Worksheets(wbDst.Worksheets.Count).Name = strFilename

'selecteer eerste cel in laatste worksheet
Set wbSht = wbDst.Worksheets(wbDst.Worksheets.Count).Select
wbSht.Range("A1").Select

' voeg lege rij in
ActiveCell.EntireRow.Insert

' bestandsnaam in cel A1
wbSht.Range("A1").Value = strFilename

wbSrc.Close False

strFilename = Dir()

Loop
wbDst.Worksheets(1).Delete

Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Cool, ik ga het uitproberen!

Nee, heb niet goed gelezen. Nu komt alles in aparte sheets met in de eerste rij de naam. Ben bijna zover...

OK, superbedankt voor je hulp!

Maar als het nu teveel data is voor één sheet, vangt de volgende het op?
Kan me in het verleden nog zoiets herinneren dat dat niet werkte.

Niet nodig, voor Excel 2007 had je nog een limiet van 65000 regels, vanaf 2007 is het een miljoen ofzo, ik heb hier 2010, dus dat komt goed.

Ik vermoed dat het zo'n 140000 regels zijn, dus dat komt goed. Als het niet werkt om die reden kan ik het in 4 stukken samenvoegen en dan die 4 files importeren in Stata.

COPY *.* NIEUWBESTAND

easy peasy, lemon squeezy

@sjemmol ja, dat zou werken als het text files zouden zijn en niet op elke regel ook de filename nodig had...

Ok, werkt... Alleen de laatste rij na het samenvoegen zou je even weg moeten halen... Succes dit weekend:

Sub samen3()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim MyPath As String
Dim strFilename As String
Dim wbStart As Integer
Dim wbEind As Integer


Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
MyPath = "C:\test" ' change to suit
Set wbDst = Workbooks.Add(xlWBATWorksheet)
Set wsDst = wbDst.Worksheets.Add
wsDst.Activate
strFilename = Dir(MyPath & "\*.xls", vbNormal)

If Len(strFilename) = 0 Then Exit Sub

Do Until strFilename = ""

Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename)
Set wsSrc = wbSrc.Worksheets("Blad3")

Set rngMaster = wsDst.Range("A65536").End(xlUp)

Aa = wsDst.UsedRange.Rows.Count
Bb = wsSrc.UsedRange.Rows.Count

' get all data cells
Set rngData = wsSrc.UsedRange
' copy data across
rngData.Copy rngMaster
wsDst.Activate
Range(Cells(Aa, 1), Cells(Bb + Aa, 1)).Select
Range(Cells(Aa, 1), Cells(Bb + Aa, 1)).Insert
Range(Cells(Aa, 1), Cells(Bb + Aa, 1)).Value = strFilename



wbSrc.Close False

strFilename = Dir()

Loop
wbDst.Worksheets(1).Delete

Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Gelukkig is Retecool niet gemaakt van Microsoftie, anders had die bovenstaande code zomaar de gehele wikikroeg in één pagina kunnen tieften. Teh horror.

Hm, ik krijg een foutmelding dat het subscript buiten het bereik valt

het gaat over Set wsSrc = wbSrc.Worksheets("Blad3")

Hier moet je invullen op welk werkblad binnen de excel-file de data staat. Bij mijn testbestanden op Blad3, bij jou waarschijnlijk op het eerste blad:
wbSrc.Worksheets(1)

Ja, dat probeerde ik gelijk, maar dat werkte niet... misschien doe ik wat fout.

Ah, ik denk dat ik het snap, het btreffende werkblad is automatisch al hetzelfde als de filenaam maar dan zonder .xls, dus elke keer anders per file...

In jouw bestanden? Dan zou je hiervoor iets van:
Set wsSrc=wbSrc.Worksheets(Left(strFilename,Len(strFilename)-4))
moeten gebruiken...
(dus het linkergedeelte van de naam, met het aantal tekens van de bestandsnaam minus 4).

Nu draait het, maar... ik zie nergens het resultaat... doe ik wat verkeerd?
Ik open een nieuwe excelmap, ga naar visual basic, voeg een module in, plak de code en pas het pad aan en klik op uitvoeren.

Als het goed is wordt er een nieuw naamloos excel-bestand geopend.

het gaat over Set wsSrc = wbSrc.Worksheets("Blad3")

Haha, jullie Mickeysoft praat Nederlands.

Computers praten Engels. Onthou dat nou.

er wordt wel een nieuwe xls map geopend, maar daar staat niks in...

Olifantje, check ff je mail... als je twee bestandjes stuurt dan zal ik even kijken wat er bij mij gebeurd....

Thx! zie mail!

Eikeltje, er werkte al iets om de bestanden in excel te krijgen. Er werkte al iets om ze samen te voegen. Kun je niet iets maken dat in ieder sheet een colom wordt toegevoegd met de naam van de sheet tussen die twee stappen in. Dan is Olifantje er ook. Ikzelf ben niet echt een excell adept, maar jij hebt al laten zien er wel wat van te weten. Zodoende. Dan hoeft Olifantje maar drie stappen uit te voeren en jij er maar een te schrijven.

Succes allebei.

Bij mij doet deze het meteen zoals Olifantje wil met onderstaande code... Maar als nu de regel wbDst.Worksheets(1).Delete in verschillende versies van excel anders werkt dan wordt eerst alles samengevoegd en daarna de bestaande pagina verwijderd. Weglaten dus... En als de data in verschillende sheets komt is het lastig om statistische bewerkingen te gaan doen. Eén sheet is dan makkelijker... Hebben we hier trouwens geen code-tag?

Sub samen()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim MyPath As String
Dim strFilename As String
Dim wbStart As Integer
Dim wbEind As Integer


Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
MyPath = "C:\test" ' change to suit
Set wbDst = Workbooks.Add(xlWBATWorksheet)
Set wsDst = wbDst.Worksheets.Add
wsDst.Activate
strFilename = Dir(MyPath & "\*.xls", vbNormal)

If Len(strFilename) = 0 Then Exit Sub

Do Until strFilename = ""

Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename)
Set wsSrc = wbSrc.Worksheets(1)

Set rngMaster = wsDst.Range("A65536").End(xlUp)

Aa = wsDst.UsedRange.Rows.Count
Bb = wsSrc.UsedRange.Rows.Count

' get all data cells
Set rngData = wsSrc.UsedRange
' copy data across
rngData.Copy rngMaster
wsDst.Activate
Range(Cells(Aa, 1), Cells(Bb + Aa, 1)).Select
Range(Cells(Aa, 1), Cells(Bb + Aa, 1)).Insert
Range(Cells(Aa, 1), Cells(Bb + Aa, 1)).Value = strFilename



wbSrc.Close False

strFilename = Dir()

Loop
wbDst.Worksheets(1).Delete

Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Eikeltje, volgens mij werkt het nu, ik heb nu in ieder geval een bestand wat er goed uitziet met iets meer dan 100.000 regels aan data. Volgens mij klopt dat. Thanks!!! En check je mail!

Behalve dan dat vanaf de 65846e regel er geen data meer wordt geimporteerd, alleen maar de filenaam. Dat komt vast omdat de xls bestandjes excel versie 2 zijn. Ik run het nu snel even in twee delen.

Set rngMaster = wsDst.Range("A65536").End(xlUp)

Daar zal dit wel vanaf komen, is de maximale grootte die ik hier aankan. Ikzelf werkt met gigantisch oude software, office 2000. Don't fix what ain't broken (behalve door over te stappen naar openoffice).

Graag gedaan, leuke puzzel. En Tralala: was voor mij ook de tweede keer dat ik iets in vba knutselde. Maar op een gegeven moment lijken alle script-talen op elkaar dus kom je met goed googelen een heel eind...

Dat van die 64k limiet wist ik zelfs. Je hoeft het maar een keer meegemaakt te hebben en je ligt de rest van je leven in de wasmand UBUNTU te roepen.

Een andere instinker is trouwens de locale-settings. Die worden op misterieuze wijze ingezet bij zowel input als output, waardoor je decimale kommaas, dmy-datums met dashes en meer van dat soort rariteiten krijgt.
Maar toch knap dat jullie er uit zijn gekomen. (ik had gedacht: 200 files: 4 uur werk; even doorbijten)

Een hoeraatje voor Eikeltje. En die locale-settings.... aaargggh!

Super, Eikeltje, heel erg bedankt! Nu komt er in de acknowledgments van mijn paper "Thanks to Little Acorn for helping out with data preparation" te staan.

En alles staat nu in Stata, waar ik vrolijk verder kan zonder Excel... *blij*