data ophalen uit verschillende excel files

[podestron]

hallo allemaal

Ik heb een probleem. Ik het vele verschillende files in één directory. In elk van die files staat een soort van Checklist met OK achter als die 'taak' gedaan is. Nu ben ik bezig om een overzichtblad te maken waarin van al die files deze checklist komt zodat ik direct kan kijken wat waar nog moet gebeuren.

Sub Collect_Data()

  Dim C As Long
  Dim DstWks1 As Worksheet
  Dim LastRow As Long
  Dim R As Long
  Dim SrcWkb As Workbook
  Dim StartRow As Long
  Dim wkbname As Variant
  Dim xlsFiles As Variant
  
   'Starting column and row for the destination workbook
    C = 2
    R = 2
   'Set references to destination workbook worksheet objects
    Set DstWks1 = ThisWorkbook.Worksheets("Blad1")
        
   'Starting row on source worksheet
    StartRow = 52
    
   'Get the workbooks to open
    xlsFiles = Application.GetOpenFilename(FileFilter:="Excel files (*.xlsm), *.xlsm", MultiSelect:=True)
      Application.AskToUpdateLinks = False
      If VarType(xlsFiles) = vbBoolean Then Exit Sub
      
     'Loop through each workbook and copy the data to this workbook
      For Each wkbname In xlsFiles
        Set SrcWkb = Workbooks.Open(Filename:=wkbname, ReadOnly:=True)
          LastRow = SrcWkb.Worksheets("ingaveblad").Cells(Rows.Count, "C").End(xlUp).Row
            If LastRow >= StartRow Then
              With SrcWkb.Worksheets("ingaveblad")
                DstWks1.Cells(R, C).Resize(LastRow - StartRow + 1, 1).Value = _
                .Range(.Cells(StartRow, "C"), .Cells(LastRow, "C")).Value
              End With
            End If
        C = C + 1
        SrcWkb.Close savechanges:=False
      Next wkbname
      
End Sub

Dit is de code die ik tot nu toe gebruikt heb. Alles gaat op zich goed. Het enige probleem is dat er nu wel de gegevens verschijnen in het overzicht maar de titel (de naam van het werkblad of CEL B2 (is ook de naam) van elk werkblad zou boven de gegevens moeten komen van dat werkblad. Nu heb ik wel de gegevens maar weet ik niet van welk blad ze komen.
Ik ben een leek in VBA. Dit heb ik gewoon in elkaar geflanst door op forums te zoeken...

Kan iemand mij helpen?

alvast bedankt.

 

[snb]

1. zet alle te integreren bestanden in 1 afzonderlijke map bijv. C:\ samen

dan kan het met

Sub samen()
  c0="C:\samen\"
  c1=dir(c0 & "*.xls")
  With workbooks.add
     do until c1=""
         with getobject(c0 & c1)
            sq= .sheets("ingaveblad").usedrange
            .close false
         End With
        With .sheets(1).cells(rows.count,1).end(xlup)
           .offset(2)=sq(2,2)
           .offset(3).resize(ubound(sq),ubound(sq,2))=sq
        End with
       c1=Dir
     Loop
     .saveas "samen.xls"
     .close false
  End with
End Sub

 

[podestron]

Bedankt voor je oplossing. Dit is inderdaad nog handiger en minder code.