samenvoegen excel bestanden in bepaalde directory

enrico85 · 12 aug 2015

Hallo allemaal,

Weet iemand hoe ik meerdere excel bestanden in een bepaalde dir. kan samenvoegen in 1 excel bestand op 1 sheet?
Het aantal regels met gegevens van deze bestanden is variabel. Soms moet ik 20 excel bestanden samenvoegen en soms 150.

Hoor graag of jullie een oplossing weten..

groet
enrico

HSV · 12 aug 2015

Probeer deze maar eens.

Code:

Sub hsv()
Dim Bestandopen As String
With Application
   .DisplayAlerts = False
   .ScreenUpdating = False
 Bestandopen = Dir(ThisWorkbook.Path & "\*")
    Do Until Bestandopen = ""
        If Bestandopen <> ThisWorkbook.Name Then
            Workbooks.Open ThisWorkbook.Path & "\" & Bestandopen
            Workbooks(Bestandopen).Sheets(1).UsedRange.Copy ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1)
            Workbooks(Bestandopen).Close True
        End If
     Bestandopen = Dir
    Loop
  .DisplayAlerts = True
End With
End Sub

Viewable · 17 aug 2015

Ik ben hier ook naar op zoek. Via zoek resultaat in dit topic terecht gekomen...

@HSV Ik neem aan dat er nog variabelen ingevuld moeten worden?? Of zet je dit excel bestand bij de te importeren bestanden??

HSV · 17 aug 2015

Er is maar één variabele, en die is gedeclareerd als string.
Het hoofdbestand moet in deze code in dezelfde map staan als waar de bestanden staan die geïmporteerd moeten worden.

snb · 17 aug 2015

als het snel moet:

Code:

Sub M_snb()
  sn= filter(split(createobject("wscript.shell").exec("cmd /c Dir """ & ThisWorkbook.Path & "\*.xls*"" /b/s").stdout.readall,vbcrlf),":")

  for each it in sn
    with createobject(it).sheets(1).usedrange
       ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1).resize(.rows.count,.columns.count)=.value
       .parent.parent.close 0
    end with
  next
End Sub

StijnJR · 21 aug 2015

Beste iedereen,

Graag zou ik een aanvulling willen vragen.
ik heb het volgende probleem:

Ik lever dagelijks producten uit, daarvan heb ik een deelfactuur.
Die sla ik op in een map met de volgende omschrijving: klantnaam-weeknummer-volgnummer.
Nu zou ik graag willen dat ik die losse excel bestanden per klant en week nummer

bij elkaar kan voegen om een totaal factuur te kunnen maken.

Is dat mogelijk ?

Groet,

Stijn

snb · 21 aug 2015

Alleen als je daarvoor een eigen vraag aanmaakt op dit forum (zie de forumregels).

StijnJR · 21 aug 2015

Beste Snb,

Mijn excuus, reeds nieuwe vraag gepost.

snb · 21 aug 2015

Parima !

enrico85 · 27 aug 2015

Ik heb de code van HSV in personal.xlsb gezet. Vervolgens het eerst bestand geopend en de macro uitgevoerd. Echter gebeurd er niks. Alle bestanden staan in dezelfde directory.
Moet ik nog iets aanpassen in de code of werkt het niet op deze manier?

HSV · 27 aug 2015

Je peronal.xlsb staat in Windows7 hier:

Code:

C:\Users\AppData\Roaming\Microsoft\Excel\XLSTART\PERSONAL.XLSB

Daar staan vast de andere bestanden niet.

enrico85 · 27 aug 2015

Nee dat klopt inderdaad, die staan ergens anders. Is het ook mogelijk om dan te verwijzen naar een andere directory waar de excel-bestanden staan en dat die dan de bestanden samenvoegt in het geopende excel-bestand?

groet
enrico

HSV · 27 aug 2015

Verander onderstaande coderegels in waar de bestanden wel staan.

Bv:

Code:

 Bestandopen = Dir(ThisWorkbook.Path & "\*")

in.

Code:

Bestandopen = Dir("c:\users\enrico\documenten\map1\*")

en deze....

Code:

Workbooks.Open ThisWorkbook.Path & "\" & Bestandopen

dan in.

Code:

Workbooks.Open "c:\users\enrico\documenten\map1\" & Bestandopen

enrico85 · 27 aug 2015

De macro doet bijna wat ik graag wil

De macro doet alleen de bestanden samenvoegen in personal.xlsb. Kan dit ook samengevoegd worden in het geopende excel-bestand? Zodat ik deze meteen weer kan opslaan.
Verder neemt die de kolombreedte niet over maar dit heeft misschien te maken omdat die het in personal.xlsb zet.
Hij heeft van 1 bestand ook niet alles gekopieerd. checkt die misschien maar tot 110 regels?

groet
enrico

HSV · 29 aug 2015

Enrico,

Een nieuw bestand wordt automatisch aangemaakt (genaamd "nieuw "+datum en tijd).
De kolommen worden op maximale breedte van de tekstbreedte gezet.
Usedrange gebruikt wat het opheffen van het laatste gevalletje denk ik wel oplost (cellen werden waarschijnlijk overschreven).

Test het zo maar eens.

Code:

Sub hsv()
Dim Bestandopen As String, naam As String
With Application
   .DisplayAlerts = False
   .ScreenUpdating = False
   Workbooks.Add
   naam = Format(Now, "dd-mm-yyyy hh_mm_ss")
  activeworkbook.SaveAs "c:\users\enrico\documenten\map1\nieuw " & naam, 51
Bestandopen = Dir("c:\users\enrico\documenten\map1\*")
Do Until Bestandopen = ""
        If Bestandopen <> ThisWorkbook.Name Then
            Workbooks.Open "c:\users\enrico\documenten\map1\" & Bestandopen
            Workbooks(Bestandopen).Sheets(1).UsedRange.Copy Workbooks("nieuw " & naam & ".xlsx").Sheets(1).Cells(Sheets(1).UsedRange.Rows.Count, 1).Offset(1)
            Workbooks(Bestandopen).Close False
        End If
     Bestandopen = Dir
    Loop
      Workbooks("nieuw " & naam & ".xlsx").Sheets(1).Columns.AutoFit
      Workbooks("nieuw " & naam & ".xlsx").Close , True
 .DisplayAlerts = True
End With
End Sub

enrico85 · 3 sep 2015

Hoi Harry,

Bij de volgende regel loopt die op vast

Workbooks(Bestandopen).Sheets(1).UsedRange.Copy Workbooks("nieuw " & naam & ".xlsx").Sheets(1).Cells(Sheets(1).UsedRange.Rows.Count, 1).Offset(1)

melding is dan:

Fout 9 tijdens uitvoering
Het subscript valt buiten bereik

HSV · 3 sep 2015

Hoi Enrico,

Je moet het bestanden-pad wel aanpassen waar de pijltjes staan achter de code.
Ik heb een kleinigheidje veranderd.

Code:

Sub hsv()
Dim Bestandopen As String, naam As String
With Application
   .DisplayAlerts = False
   .ScreenUpdating = False
   Workbooks.Add
   naam = Format(Now, "dd-mm-yyyy hh_mm_ss")
  activeworkbook.SaveAs "c:\users\enrico\documenten\map1\nieuw " & naam, 51   ' ←
Bestandopen = Dir("c:\users\enrico\documenten\map1\*")  ' ←
Do Until Bestandopen = ""
        If Bestandopen <> ThisWorkbook.Name Then
            Workbooks.Open "c:\users\enrico\documenten\map1\" & Bestandopen    ' ←
            Workbooks(Bestandopen).Sheets(1).UsedRange.Copy Workbooks("nieuw " & naam & ".xlsx").Sheets(1).Cells(Sheets(1).UsedRange.Rows.Count, 1).end(xlup).Offset(1)
            Workbooks(Bestandopen).Close False
        End If
     Bestandopen = Dir
    Loop
      Workbooks("nieuw " & naam & ".xlsx").Sheets(1).Columns.AutoFit
      Workbooks("nieuw " & naam & ".xlsx").Close  True
 .DisplayAlerts = True
End With
End Sub

enrico85 · 14 sep 2015

Hallo Harry,

Heb even een klein voorbeeld bestand gemaakt waar ik mee werk.

Hij loop nu vast op

Code:

Workbooks("nieuw " & naam & ".xlsx").Sheets(1).Columns.AutoFit

Heb er al Blad1 van gemaakt maar helpt niet.

groeten
enrico

HSV · 14 sep 2015

Hallo Enrico,

Geen idee, hier werkt het feilloos.
Als je met F8 de code doorloopt, wat is de waarde van 'naam'?

enrico85 · 15 sep 2015

Hallo Harry,

Dat is wel erg vreemd dan.

Wat bedoel je precies met de waarde van 'naam'? het nieuwe bestand dat die aanmaakt?
Als ik de code doorloop met F8 krijg ik vaak de melding 'kan de programmacode niet uitvoeren in de onderbrekingsmodus'.

Enig idee wat het probleem dan kan zijn?

groet
enrico

samenvoegen excel bestanden in bepaalde directory

Gebruiker

Inventaris

Gebruiker

Inventaris

Verenigingslid

Gebruiker

Verenigingslid

Gebruiker

Verenigingslid

Gebruiker

Inventaris

Gebruiker

Inventaris

Gebruiker

Inventaris

Gebruiker

Inventaris

Gebruiker

Bijlagen

Inventaris

Gebruiker

Wij waarderen jouw privacy