macro om data uit andere excelbestanden samen te voegen

Kristinho1978 · 24 dec 2015

Beste allemaal,

Ik heb een ingewikkeld kerstvraagstuk

Op het netwerk staat een map "a" met een x aantal submappen. [In de tijd zullen hier mappen met nog onbekende benamingen aan worden toegevoegd]
In deze submappen staan een y aantal excelbestanden. Deze hebben allemaal verschillende - nog onbekende - benamingen. De bestanden hebben echter ook iets gemeen: ze hebben allemaal een identiek tabblad genaamd "Naam". Dit tabblad bevat data in de kolommen A tot en met X. Het aantal rijen is variabel per file. [Daarnaast hebben ze nog de standaardtabbladen "Sheet1", "Sheet2" en "Sheet3"]

Nu mijn vraag: ik wil graag een consolidatie excel maken waarin ik middels een macro alle tabbladen "Naam" van de verschillende files uit de verschillende mappen kan inlezen.
Deze excel mag van exact hetzelfde format zijn als de verschillende "Naam" bladen (dus ook kolom A tot en met X). Daaraan zou ik echter per regel graag twee dingen willen toevoegen: in kolom Y de naam van het bestand waar de regel uit komt en in kolom Z de naam van de map waar de regel (en dus het bestand uit kolom Y) uit komt.

Ik benieuwd naar een werkende macro

:thumb:

mvw64 · 25 dec 2015

Misschien helpt deze macro jou verder

Code:

Sub HaalOp()
    'Application.ScreenUpdating = False
    Sheets("Blad1").Range("A:X").ClearContents 'Wissen

[B]'Pas het pad ("C:\Test\Folder") aan[/B]
    For Each fl In CreateObject("scripting.filesystemobject").getfolder("C:\Test\Folder").Files
    With Workbooks.Add(fl)

[B]'Vul pad en bestandsnaam in[/B]
    ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1) = fl

[B]'Een van deze twee regels gebruiken
'Een variabele range[/B]
    '.Sheets("Naam").UsedRange.Copy ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1)
'Een vaste range
    .Sheets("Naam").Range("A2:X50").Copy ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1)

    .Close False 'Werkmap sluiten
End With
Next
    Application.ScreenUpdating = True
End Sub

Kristinho1978 · 28 dec 2015

werkt nog niet...

Hoi hoi,

Bedankt voor je reactie!

Ik heb de macro aan de consolidatie excel toegevoegd. Na wat kleine aanpassingen draait ie nu zonder foutmelding - dat is het goede nieuws - maar ik zie helaas geen data verschijnen.
Misschien komt het doordat in de verschillende files de eerste dataregel steeds op regel 5 staat - was ik vergeten te vermelden

Dit is wat ik nu heb:

Sub Consolidation()

Application.ScreenUpdating = False
Sheets("ConsolidatieNaam").Range("A5:X1000000").ClearContents

For Each fl In CreateObject("scripting.filesystemobject").getfolder("\\...\a").Files
With Workbooks.Add(fl)

ThisWorkbook.Sheets("Naam").Cells(Rows.Count, 1).End(xlUp).Offset(1) = fl
.Sheets("Naam").UsedRange.Copy ThisWorkbook.Sheets("ConsolidatieNaam").Cells(Rows.Count, 1).End(xlUp).Offset(1)
.Close False

End With
Next

ActiveWorkbook.Save
Application.ScreenUpdating = True

End Sub

PS Mocht je (of iemand anders) ook nog een idee hebben hoe ik kolom Y en Z (Naam bestand en naam map) kan vullen, dan hoor ik het graag

mvw64 · 29 dec 2015

Je zal toch minimaal een pad letter moeten opgeven

Kristinho1978 · 29 dec 2015

werkt helaas nog altijd niet...

Hoi hoi,

Ik heb het pad aangepast, maar nog altijd hetzelfde resultaat. Geen foutmelding maar ook geen data

Sub Consolidation()

Application.ScreenUpdating = False
Sheets("ConsolidatieNaam").Range("A5:X1000000").ClearContents

For Each fl In CreateObject("scripting.filesystemobject").getfolder("C:\...\a").Files
With Workbooks.Add(fl)

ThisWorkbook.Sheets("Naam").Cells(Rows.Count, 1).End(xlUp).Offset(1) = fl
.Sheets("Naam").UsedRange.Copy ThisWorkbook.Sheets("ConsolidatieNaam").Cells(Rows.Count, 1).End(xlUp).Offset(1)
.Close False

End With
Next

ActiveWorkbook.Save
Application.ScreenUpdating = True

End Sub

mvw64 · 29 dec 2015

Wat bedoel je met C:\... daar zal de naam van de folder/map moeten staan b.v C:\Test

Kristinho1978 · 29 dec 2015

...

klopt, daar staat de locatie. Maar het lijkt me niet nuttig om die op het forum te zetten dus heb ik 'm ingekort.
In feite staat daar "C:\Test\a" inderdaad.

Maar helaas werkt ie nog steeds niet

mvw64 · 29 dec 2015

Dus de werkmappen staan in:
Pad C:\
1e Folder is Test\
2e Folder is a

Klopt dit

Kristinho1978 · 29 dec 2015

...

Ja, dat klopt.

En de macro draait zonder probleem (zonder foutmelding), maar de data uit de verschillende files wordt niet ingeplakt.
Hij draait wel vrij kort dus het lijkt me onwaarschijnlijk dat ie ook echt alle mappen en bestanden af gaat.

mvw64 · 29 dec 2015

Bij mijn werkt het wel.
Het spijt me dat ik je dan niet verder kan helpen

HSV · 29 dec 2015

Werkt hier prima.
Daar ik op 27-12-2015 een soortgelijke vraag heb opgelost, kon ik het snel testen.

Daar worden de bestanden welleswaar verdeeld over drie bladen en naast elkaar.
Ik had de map met twaalf bestanden nog, en heb de naam van de sheet veranderd in 'Sheets(1).
http://www.helpmij.nl/forum/showthr...xcel-bestanden-samenvoegen-in-1-Excel-werkmap

Ik heb het zelf even zo uitgewerkt, en alles wordt netjes onder elkaar gezet.

Code:

Sub Consolidation()
 Application.ScreenUpdating = False
 'Sheets("ConsolidatieNaam").Range("A5:X1000000").ClearContents
 For Each fl In CreateObject("scripting.filesystemobject").getfolder("C:\users\hsv\desktop\Testmap").Files
 With Workbooks.Add(fl)
 ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1) = fl
 .Sheets(1).UsedRange.Copy ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1)
 .Close False
 End With
 Next
 ActiveWorkbook.Save
 Application.ScreenUpdating = True
 End Sub

Kristinho1978 · 29 dec 2015

aha

Ah ik zie al wat het probleem is

Jullie gaan er denk ik van uit dat de excelbestanden in map ''a'' (of map ''Testmap'') zitten.
De realiteit is echter dat er nog een mappenreeks tussen zit. Zie mijn probleem omschrijving:

>>>Op het netwerk staat een map "a" met een x aantal submappen. [In de tijd zullen hier mappen met nog onbekende benamingen aan worden toegevoegd]
In deze submappen staan een y aantal excelbestanden.<<<

Dus de excelbestanden staan niet direct in de map die in de macro wordt meegegeven, maar juist in de submappen van deze map. Als ik de excels in de hoofdmap plaats, krijg ik inderdaad wel een resultaat.

Er blijven dus nog een paar vragen:
- hoe krijg ik het voor elkaar dat de macro niet naar excels in de hoofdmap kijkt, maar juist naar de excels in alle submappen?
- hoe krijg ik het voor elkaar dat de macro kijkt naar data vanaf regel 5 in plaats van vanaf regel 1? (En ook inplakt vanaf regel 5 i.p.v. regel 1)
- hoe krijg ik het voor elkaar dat de bestandsnaam en de map, die nu steeds boven de data worden weergegeven, in kolom Y en kolom Z worden weergegeven?

Dus het mysterie is opgelost, maar er zijn nog wat vraagjes

Kristinho1978 · 31 dec 2015

iets verder

Ik ben alweer een muizenstapje verder...

Ik heb op Sheet2 een Macro2 gemaakt die een lijst van alle subfolders maakt in een tweede sheet van mijn consolidatie-excel (vanaf cel B2 naar onder):

Sub Macro2()
Dim objFSO As Object
Dim objFolder As Object
Dim objSubFolder As Object
Dim i As Integer

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\...\a")
i = 1
For Each objSubFolder In objFolder.subfolders
Cells(i + 1, 1) = objSubFolder.Name
Cells(i + 1, 2) = objSubFolder.Path
i = i + 1
Next objSubFolder
End Sub

Deze macro combineer ik nu met mijn oorspronkelijke - enigzins aangepaste - macro, die er nu zo uitziet:

Sub Macro1()
Dim j As Integer
Path = Worksheets("Sheet2").Range("B2").Offset(j, 0)

Sheets("ConsolidatieNaam").Range("A11:X1000000").ClearContents
Range("A5").Select
Application.ScreenUpdating = False

For j = 0 To 80
For Each fl In CreateObject("scripting.filesystemobject").GetFolder(Path).Files
With Workbooks.Add(fl)
ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1) = fl
.Sheets(1).UsedRange.Copy ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1)
.Close False
End With
Next
Next j

Application.ScreenUpdating = True

End Sub

Deze macro neemt dus nu iedere keer een pad dat op Sheet 2 in kolom B is aangemaakt. Althans, dat zou het moeten doen, maar om de een of andere reden werkt de loop niet.. De macro blijft maar j = 0 gebruiken in plaats van (wat ie zou moeten doen

eerst j = 0, dan j = 1, dan j = 2 etc. Waarschijnlijk een heel stomme simpele fout, maar ik zie 'm niet... Wie het ziet mag het zeggen... (1)

En dan is er nog een ander heel vervelend issue. De laatste macro kopieert de data uit de verschillende excelfiles, maar doordat hier vaak een link aan hangt die niet geupdatet kan worden (dat hoeft ook niet), krijg ik steeds heel vervelende foutmeldingen. Oplossingen met "Application.AskToUpdateLinks = False" werken helaas niet. Ik denk dat ik iets moet doen met plakken als waarden maar ik weet niet goed hoe ik de macro daarvoor moet aanpassen. Wie kan helpen? (2)

De andere problemen zijn er ook nog (dat steeds alles vanaf regel 1 wordt ingeplakt, terwijl de data pas op regel 5 begint ; dat de locatie van de data bovenaan staan in de beginkolom in plaats van aan de rechterkant in kolom Y en Z), maar dat zijn op dit moment kleinere problemen. Ik zou graag (1) en (2) als eerste gefixt hebben

Allle hulp is welkom

HSV · 31 dec 2015

Graag de codes tussen codetags plaatsen zoals hier in mijn bericht.
Waarom j nul blijft is me een raadsel, maar op deze plek de coderegel Path werkt in ieder geval al beter.

Code:

for j = 0 to 80
  Path = Worksheets("Sheet2").Range("B2").Offset(j, 0)

Kristinho1978 · 31 dec 2015

uitstekend!

Ja, perfect, daarmee werkt het inderdaad wel, dankjewel

Da's fijn, dan heb ik in ieder geval de juiste output. Blijven nu alleen nog de kosmetische ingrepen over

Nog even een korte samenvatting van het grootste nog overgebleven probleem: de excelbestanden waarvan de data wordt ingelezen, bevatten links naar bronbestanden. Als ik de macro nu draai, krijg ik deze meldingen bij ieder excelbestand dat ingelezen wordt:

Vervolgens moet ik op "Don't update" klikken en krijg ik alsnog een menu om een bronbestand te selecteren, wat ik met "Cancel" moet beantwoorden.
Graag zou ik zien dat de macro geen rekening houdt met de links - hij mag gewoon de waarden nemen die in het excelbestand staan. Ik heb alleen geen flauw idee hoe en waar ik dat in mijn Macro moet aanpassen. Wie heeft de gouden tip?

HSV · 31 dec 2015

Test dit eens.

Code:

For j = 0 To 80
Path = Worksheets("Sheet2").Range("B2").Offset(j, 0)
    For Each fl In CreateObject("scripting.filesystemobject").GetFolder(Path).Files
         With Workbooks.Add(fl)
           ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1) = fl
             .Sheets(1).UsedRange.Copy ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1)
      [COLOR=#FF0000]      thisworkbook.ChangeLink activeWorkbook.FullName, thisWorkbook.FullName, xlLinkTypeExcelLinks[/COLOR][COLOR=#FF0000][/COLOR]
         .Close False
    End With
    Next
  Next j

Kristinho1978 · 31 dec 2015

Ik krijg helaas nog dezelfde melding...

HSV · 31 dec 2015

Probeer dit eens:

Code:

Sub Macro1()
application.displayalerts = false
...verdere code.....
application.displayalerts = true
end sub

Kristinho1978 · 31 dec 2015

Ehhhm, hoe doe ik dat precies? Want als ik die sub in mijn sub voeg, dus een sub in een sub, dan krijg ik een foutmelding...

Waar moet ik de twee bovenste regels en de twee onderstte regels precies plaatsen?

HSV · 31 dec 2015

Ik heb mijn vorig schrijven aangepast: sub hup() is sub Macro1() geworden.

macro om data uit andere excelbestanden samen te voegen

Gebruiker

Gebruiker

Gebruiker

Gebruiker

Gebruiker

Gebruiker

Gebruiker

Gebruiker

Gebruiker

Gebruiker

Inventaris

Gebruiker

Gebruiker

Inventaris

Gebruiker

Inventaris

Gebruiker

Inventaris

Gebruiker

Inventaris

Wij waarderen jouw privacy