VBA code om informatie uit meerdere bestanden te halen

[Hunuloeloe]

Beste helpers,

Momenteel wordt er per dag de productie bijgehouden in een excel bestand. Echter wordt er voor elke nieuwe dag een nieuw tabblad aangemaakt en hier wordt alles opnieuw ingevuld. Nu heb ik dus in een map 12 bestanden staan die als naam "Dagproductie (maand)" hebben en elk bestand is opgebouwd uit 28 tot 31 tabbladen waar de dagproductie in is opgenomen. Nu moet steeds handmatig alles gekopieerd worden om de maandproductie te kunnen laten zien. Ik vraag me af of het mogelijk is om een leeg bestand te hebben waarin ik met een druk op de knop alle data omtrend de productie in een bestand te zien kan krijgen. Echter zit er nog een addertje onder het gras en dat is dat niet alle gegevens op dezelfde plek in het tabblad staan. In de meeste bestanden staat de productie vermeld in cel B77 maar in sommige ook ergens anders.

De productie wordt wel altijd vermeldt in kolom B naast een cel genaamd Prod. Uitslag in kolom A

Om het even op te sommen:
- de bestanden beginnen allemaal met Dagproductie en vervolgens de maand (Dagproductie januari)
- alle bestanden hebben tabbladen verschillend van 28 tot 31 (de dagen)
- Hetgeen wat opgevraagd moet worden door de code staat in kolom B naast een cel genaamd Prod. Uitslag (kolom A)

Ik hoop dat iemand me hiermee kan helpen

PS
Een voorbeeld bestand leek me in dit geval niet vereist omdat de code in een knop moet worden opgenomen in een kaal bestand.

 

[SjonR]

Anthony,

Je wil een maandproductie maken, maar je hebt per maand al een bestand.


Kan je misschien 1 voorbeeldbestand plaatsten?

zonder voorbeeld maar gegokt.

knop drukken, betreffende map selecteren en dan doet ie het hopelijk

 

[Hunuloeloe]

Sjon,

Bedankt voor je reactie. Ik heb je oplossing gebruikt maar het werkte niet helemaal. Hierbij heb je een voorbeeld bestand van een maand.
Bekijk bijlage Dagproductie april 2017.xlsx
In dit voorbeeld staat de uitslag productie in cel B77
Maar zoals ik eerder al aangaf zijn er dus ook bestanden met tabbladen waarin deze productie in een andere cel is opgenomen... (kan het helaas niet veranderen :shocked

Ik hoop dat de vraag nu duidelijker wordt.

 

[Hans123]

Anthony,

Bestand van Sjon werkt prima maar heeft wel last van (lege) "blad1". VBA zoekt op dat blad naar Prod. Uitslag in kolom A en kan dat uiteraard niet vinden en geeft daarop een foutmelding.
Oplossing kan zijn om domweg blad1 te verwijderen óf in de code te testen of een juist soort blad is geactiveerd. 1e is denk ik het makkelijkst.

 

[Hunuloeloe]

Hans,

Je hebt gelijk dank hiervoor! Het bestand doet precies wat ik wil maar nu heeft Sjon er iets bijgevoegd wat interresant is namelijk: in de kolom dag krijg ik gelijk de dag van het tabblad te zien maar deze neemt die niet correct over. Als ik de maandproductie van april ermee upload (zie mijn eerdere post) dan krijg ik van 1 t/m 9 april hele rare gegevens in deze kolom te zien (namelijk 4-1, 4-3, 4-5, 4-7, 4-8 ipv 1-4, 3-4, 7-4, 8-4 ) ... Weet iemand hoe dat komt?

Sub SjonR()

Dim wbk As Workbook, sh As Worksheet, doel As Workbook
Set doel = ThisWorkbook
Application.ScreenUpdating = False

    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
        .AllowMultiSelect = False
        MyFolder = .SelectedItems(1) & "\"
    End With

MyFile = Dir(MyFolder)

Do While MyFile <> “”
Set wbk = Workbooks.Open(Filename:=MyFolder & MyFile)

    For Each sh In wbk.Sheets
        With doel.Sheets("Blad1")
            .Activate
            X = .Range("A" & Rows.Count).End(xlUp).Row + 1
            .Cells(X, 1).Value = sh.Name
            .Cells(X, 2).Value = wbk.Name
            .Cells(X, 3).Value = sh.Columns(1).Find("Prod. Uitslag").Offset(, 1).Value
        End With
    Next
wbk.Close savechanges:=False
MyFile = Dir
Loop
Application.ScreenUpdating = True
End Sub

 

[VenA]

Om het geheel wat te versnellen en de juiste datum. Dit zal je even moeten combineren met de andere code.

Sub VenA()
ReDim ar(Sheets.Count, 1)
  For Each sh In Sheets
    If IsDate(sh.Name) Then
      ar(t, 0) = CDate(sh.Name)
      ar(t, 1) = sh.Cells(Application.Match("Prod. Inslag", sh.Columns(1), 0), 2)
      t = t + 1
    End If
  Next sh
  Sheets("Blad1").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(ar), 2) = ar
End Sub