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

een directory doorlopen, tabbladen kopieren en totaal uitrekenen

  • Onderwerp starter Onderwerp starter Delee
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.
D

Delee

Gebruiker
Lid geworden
22 jul 2007
Berichten
32
Zeer gewaardeerd Helpmij forum,

Ik moet voor een afdeling op mijn werk een tijdschrijven-sheet maken.
Zie bijgaand.
1) Ik probeer nu met een VBA scriptje binnen een directory naar alle bestanden te zoeken en deze als tabbladen op te nemen. Het scriptje zie ik wel lopen maar slaat uiteindelijk niet op. Waar zit de fout?:(

2) Op het eerste tabblad -weektotaal!- moet ik de cumulatieven van alle tabbladen berekenen.
Omdat de bezetting op de afdeling nogal eens wijzigt, kan ik de som van alle tabbladen niet uitschrijven. Is hier ook een oplossing voor?:confused:

Ik kijk uit naar uw reactie.
groet, leo:thumb:
 

Bijlagen

Leo, vervang jouw macro met onderstaande

Code: 
Sub RunCodeOnAllXLSFiles()
    Dim lCount As Long
    Dim wbResults As Workbook
    Dim wbCodeBook As Workbook
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
    End With
    
    On Error Resume Next
     
    Set wbCodeBook = ThisWorkbook
    
    With Application.FileSearch
        .NewSearch
        .LookIn = "D:\Leo\Mijn werk\BJZ Flevoland\Excel TEST\Werkdirectory" 'Change path to suit
        .FileType = msoFileTypeExcelWorkbooks
        If .Execute > 0 Then 'Workbooks in folder
            For lCount = 1 To .FoundFiles.Count ' Loop through all.
                Set NewSheet = Sheets.Add(Type:=xlWorksheet)
                 'Open Workbook x and Set a Workbook variable to it
                Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
                wbResults.Worksheets("Blad1").Range("A1:AB65").Copy Destination:=wbCodeBook.ActiveSheet.Cells(1, 1)
                wbResults.Close SaveChanges:=False
                    If Range("B5").Value <> "" Then
                    ActiveSheet.Name = Range("B3").Value
                    End If
            Next lCount
        End If
    End With
     
    On Error GoTo 0
    
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With

End Sub

Mvg

Rudi
 
Hoi Warme Rudi Bakker,
Jouw code is wel netter maar doet hetzelfde als de mijne. :confused:
In de loop, wanneer hij geen nieuwe bestanden meer vind, knalt ie eruit zonder op te slaan. :(
Zou dat aan een instelling bij mij liggen? :rolleyes:
Wanneer ik de macro doorloop en vlak voor het eruit knallen zelf opsla dan slaat ie het wel op. :shocked:

Wat ik ook niet snap is dat als je in de scripteditor kijkt, zie je het werkblad, this workbook en -naar gelang- modules. Je kan in alle drie een script hangen. Wat is het verschil daartussen? Ik vermoed dat scripts in This Workbook voor het hele excel bestand geldt, in het werkblad alleen voor dat werkblad en modules...alleen op afroep (door een buttondruk ofzo?)???:o

Zal ik voor de cumulatieven op blad 1 een andere forum vraag openen?:eek:

Ik hoop op jouw reactie, (anderen mogen zich vrij mengen);)

Greot,
Leo
 
Code: 
Sub RunCodeOnAllXLSFiles()
    Dim lCount As Long
    Dim wbResults As Workbook
    Dim wbCodeBook As Workbook
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
    End With
    
    On Error Resume Next
     
    Set wbCodeBook = ThisWorkbook
    
    With Application.FileSearch
        .NewSearch
        .LookIn = "D:\Leo\Mijn werk\BJZ Flevoland\Excel TEST\Werkdirectory" 'Change path to suit
        .FileType = msoFileTypeExcelWorkbooks
        If .Execute > 0 Then 'Workbooks in folder
            For lCount = 1 To .FoundFiles.Count ' Loop through all.
                Set NewSheet = Sheets.Add(Type:=xlWorksheet)
                 'Open Workbook x and Set a Workbook variable to it
                Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
                wbResults.Worksheets("Blad1").Range("A1:AB65").Copy Destination:=wbCodeBook.ActiveSheet.Cells(1, 1)
                wbResults.Close SaveChanges:=False
                    If Range("B5").Value <> "" Then
                    ActiveSheet.Name = Range("B3").Value
                    End If
            Next lCount
        End If
    End With
     
    On Error GoTo 0
    
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With
[COLOR="Red"]ActiveWorkbook.Close SaveChanges:=True[/COLOR]
End Sub

Mvg

Rudi
 
Hi Rudi,
Hij slaat 'em nog niet op hoor...:(
Overigens hernoemt ie het tabblad ook niet.:confused:
Geef het niet op! ;)
Groet,
Leo
 
Leo, heb je de macro in een gewone module geplakt want bij mij loopt hij als een trein.
In bijlage één mijner probeersels

Mvg

Rudi
 

Bijlagen

O O O O, wat ben ik een vreselijke oen...ik had het bestand staan in dezelfde directory als waarin hij zocht...geplaatst in een andere dir toen deed ie het gewoon. (die van mij ook ;)) Evenzogoed heel erg bedankt voor je geduld!

Zou je mij ajb ook nog kunnen helpen met het uitrekenen van de totalen: Op het eerste tabblad -weektotaal!- moet ik de cumulatieven van alle tabbladen berekenen.
Omdat de bezetting op de afdeling nogal eens wijzigt, kan ik de som van alle tabbladen niet uitschrijven (blad2!b3+blad3!b3 etc). Is hier ook een oplossing voor?

Groet,
Leo(oenig soms):thumb:
 
Leo, bedoel je hiermee dat het aantal geïmporteerde tabbladen telkens kan verschillen ?
En hebben ze allen dezelfde layout?

Mvg

Rudi
 
Hoi Rudi,
Ja, alle tabbladen hebben precies dezelfde layout. Het aantal verschilt per week.
Op het eerste tabblad moet in corresponderende cellen de som komen van de cellen op de overige tabbladen. Als ik middels VBA ga optellen blad1!:blad30! (ik noem maar een aantal) dan vraagt ie om de tabbladen ie dan weer niet voorkomen in het bestand. Annuleren klikken kan wel maar is niet zo netjes.
Tot dusver mijn ervaringen.
Ik heb zelf al zitten denken om een lijst van de tabbladen te maken (dat is me gelukt) en mbv deze lijst dan weer de som te generen (daar ben ik nog op aan het puzzelen...wel leuk hoor dat stoeien en zoeken).

Maar als je een goede tip hebt...houd ik me aanbevolen.:thumb:

Groet,
Leo
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan