Meerdre bestanden openen via een macro.

[Relleboer]

Ik zit met het volgende:

ik moet uit een bepaald bestand alle exel files wie erin staan openen voor verdere bewerking. Ik zou dat door middel van een macro willen doen zodat andre er ook met gemak mee kunnen werken. Zou iemand mij op gang kunnen helpen.

Alvast bedankt.

 

[Relleboer]

ik heb het volgende al bij elkaar weten te sprokkelen. Het geeft alle bestanden weer in de bepaalde file.

Sub ListFiles2()
Dim LastStartPoint As String
Dim directories() As String, CurrentDirectory As String
Dim DirCounter As Integer, DirValue As String
Dim filelist As Variant

On Error GoTo 0

StartPoint = "C:\Documents and Settings\Lab\Mijn documenten\Data voor grafieken"

Range("A1").Select
filelist = Range(ActiveCell, ActiveCell.End(xlDown).Offset(0, 2)).Value
ReDim directories(2)

If Right(StartPoint, 1) = "\" Then
 directories(1) = StartPoint
Else
 directories(1) = StartPoint & "\"
End If

directories(2) = ""

DirCounter = 1
FileCount = 0
On Error Resume Next

Do While directories(DirCounter) <> ""
 CurrentDirectory = directories(DirCounter)
 
  DirValue = Dir(CurrentDirectory, vbDirectory)

 Do While DirValue <> ""
  
    If InStr("..", DirValue) = 0 Then
   
    dirok = GetAttr(CurrentDirectory & DirValue) And vbDirectory
   If dirok Then
     
    ReDim Preserve directories(UBound(directories) + 1)
    directories(UBound(directories) - 1) = CurrentDirectory & DirValue & "\"
   Else
    
    FileCount = FileCount + 1
    filelist(FileCount, 1) = CurrentDirectory & DirValue
   
    DoEvents
   End If
  End If
    
  DirValue = Dir()
 Loop
 DirCounter = DirCounter + 1
 
 Loop

Range(ActiveCell, ActiveCell.End(xlDown).Offset(0, 2)).Value = filelist
Application.StatusBar = False

End Sub

Maar heb nu niet het idee dat ik op de goede weg ben.

 

[Wigi]

Wellicht is dit van nut:

http://www.ozgrid.com/VBA/loop-through.htm

 

[Relleboer]

Wigi,

Hier kan ik zeker wat mee. Alleen loop ik nog vast op iets maar daar ga ik eerst zelf weer proberen uit te komen. tot zover al bedankt.

ik meld me wel weer als ik het niet red. laat daarom post nog ff open

 

[Relleboer]

Het volgende probleem kom ik tegen. Doormiddel van de code hieronder openend en bewerkt de code bestanden in een map. Van elk bestand neemt hij ook gegevens over na de werk map waarin de code staat. Nu wil ik dat hij van de overgenomen gegevens een grafiek maak. Maar aangezien het meer of minder bestanden kunenn zijn in de map is het aantal lijnen dat in de grafiek moet komen ook anders. Heo kan ik de grafiek laten maken met alle gevonden data. (soort dynamische bereik of zo ).

Sub RunCodeOnAllXLSFiles()
Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

On Error Resume Next

Set wbCodeBook = ThisWorkbook

    With Application.FileSearch
        .NewSearch
         'Change path to suit
        .LookIn = "C:\Documents and Settings\Lab\Mijn documenten\Data voor grafieken"
        .FileType = msoFileTypeExcelWorkbooks
        .Filename = "*.csv"
        
            If .Execute > 0 Then 'Workbooks in folder
                For lCount = 1 To .FoundFiles.Count 'Loop through all.
                 'Open Workbook x and Set a Workbook variable to it
                 Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
                                  
                  NumberFormat = "0.00"
        Range("L2").FormulaR1C1 = "=RC[-11]-R2C1"
    With Range("L2")
        .Copy
        .AutoFill Range(.Cells(1), .Offset(, -1).End(xlDown).Offset(, 1))
    End With
        Range("M2").FormulaR1C1 = "=RC[-9]/1000"
    With Range("m2")
        .Copy
        .AutoFill Range(.Cells(1), .Offset(, -1).End(xlDown).Offset(, 1))
    End With
        Range("l1").Value = Worksheets(1).Name
        Columns("L:M").Copy
        Windows("Graphics jules.xls").Activate
        Range("a1").PasteSpecial (xlPasteValues)
        Columns("A:b").Select
        Selection.Insert Shift:=xlToRight
                 wbResults.Close SaveChanges:=False
             
                 Next lCount
            End If
    End With
    
    On Error GoTo 0
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
End Sub

Bijvoorbeeld cel a1 bevat naam van reeks en a2:b2 en verder na onder zijn de x en y waardes. enzo verder met c1 ................. tot hoeveel er staan.