submappen benaderen

[vriesdeb]

Hallo,

Ik heb een map met daarin een 3000 excel documenten verdeeld over 32 verschillende mappen (wijken).
Elk document heeft dezelfde lay-out, en ik zou graag een totaal overzicht maken via een macro.
In dit overzicht wil ik bepaalde cellen selecteren, om zo een vergelijking te kunnen maken.

Ik ben zover dat ik dit per map(wijk) voor elkaar krijg.
Maar om 32 macro's te maken en deze dan om de beurt regelmatig te starten vind ik wat omslachtig.
Ik heb in een totaal andere macro namelijk een regel staan waardoor de submappen meegenomen worden.

Dit zou ideaal zijn om dat in deze macro ook te verwerken.

Hieronder de code welke ik momenteel gebruik:

Option Explicit
Const sInlezen  As String = "B3, B4, B5, K9, K55, I9, B9"  'uit te lezen cellen
Const sPad      As String = "O:\Dienstverlening\Berekening\2012\wijk 1" 'directory waaruit gelezen moet worden
Const sBlad     As String = "Blad1" 'blad waaruit gelezen moet worden
Sub InlezenBestanden()
      Dim inlezen As Variant, fl, c As Range, i As Integer, i0 As Integer
  i0 = Range(sInlezen).Cells.Count  'aantal cellen die je wenst uit te lezen -1
  Application.DisplayAlerts = False
  
  With Sheets("blad1")
    For Each fl In CreateObject("scripting.filesystemobject").Getfolder(sPad).Files
      If Right(fl.Name, 4) = ".xls" Then
        Workbooks.Open sPad & "\" & fl.Name
        On Error Resume Next
        ReDim inlezen(i0)
        inlezen(0) = fl.Name
        i = 1
        For Each c In Sheets(1).Range(sInlezen) 'kies hier het juiste werkblad !!!
          inlezen(i) = c.Value 'opeenvolgende cellen worden netjes weggeschreven in die array
          i = i + 1
        Next
        ActiveWorkbook.Close
        If Err.Number <> 0 Then
          Err.Clear
        Else
          If c(1) = "V" Then
          .Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(1, i0 + 1) = inlezen
          End If
        End If
      End If
    Next
  End With
  Application.DisplayAlerts = True
End Sub

Hopelijk kan iemand mij verder helpen.
En mocht er meer info nodig zijn, hoor ik het graag!

 

[snb]

Hiermee moet je een eind kunnen komen:

sub snb()
  for j=1 to 32
    c00="O:\Dienstverlening\Berekening\2012\wijk " & j & "\"
    c01=dir(c00 & "*.xls")

    do until c01=""
      for jj=1 to 7
         c02=c02 & "_" & "'" & c00 & "[" & c01 & "]Blad1'!" & choose(jj,"B3","B4","B5", "K9", "K55", "I9", "B9")
      next
      c02=c02 & "|"
      c01=dir
    loop
  next

  sn=split(c02,"|")
  for j=0 to ubound(sn)
    sp=split(sn(j),"_")
    for jj=1 to ubound(sp)
        thisworkbook.sheets(1).cells(j+1,jj)="=" & sp(jj)
    next
  next
End sub

 

[vriesdeb]

Dank voor je reactie snb, echter met deze code krijg ik helemaal niets.
terwijl alle gegevens wel overeen komen.

Mijn fout, hij werkt wel degelijk.
Enorm bedankt!