basReadInExcel.bas

Attribute VB_Name = "basReadInData"
Public Sub doProcessAllFiles()
' Ben Jacobson 2015
' reads and builds a data table of specific cells from all workbooks in same folder
' I have failed to note where I copied sections from, so I apologize. This is why I give back.

   Dim sThisFilePath          As String
   Dim sFile                  As String
   Dim wbk As Workbook
    
   ' open all workbooks that share a path with this
   sThisFilePath = ThisWorkbook.Path
   If (Right(sThisFilePath, 1) <> "\") Then sThisFilePath = sThisFilePath & "\"
    
   sFile = Dir(sThisFilePath & "*.xlsx*")
   Do While sFile <> vbNullString
        Workbooks.Open Filename:=sThisFilePath & sFile
      sFile = Dir
   Loop
   
   Z = 0
   y = 0
   x = 0
   
   For Each wbk In Workbooks 'check for all open workbooks, uses properties of collection
        If wbk.Name <> ThisWorkbook.Name Then
            ThisWorkbook.Activate
        'visit first two sheets of each
        For Z = 1 To 2 'worksheets, can adjust to correct worksheet range
        
        'worksheet range constants
        dno = wbk.Worksheets(Z).Range("c31").Value
        bnr = wbk.Worksheets(Z).Range("d31").Value
        
            For y = 0 To 15 'number of rows to read
        
                'read week into second worksheet
                Worksheets(2).Range("a2").Offset(k, 0) = dno
                Worksheets(2).Range("a2").Offset(k, 1) = bnr
                Worksheets(2).Range("a2").Offset(k, 2) = wbk.Worksheets(Z).Range("d35").Offset(y, 0)
                Worksheets(2).Range("a2").Offset(k, 3) = wbk.Worksheets(Z).Range("d35").Offset(y, 1)
                Worksheets(2).Range("a2").Offset(k, 4) = wbk.Worksheets(Z).Range("d35").Offset(y, 2)
                Worksheets(2).Range("a2").Offset(k, 5) = wbk.Worksheets(Z).Range("d35").Offset(y, 3)
                Worksheets(2).Range("a2").Offset(k, 6) = wbk.Worksheets(Z).Range("d35").Offset(y, 5)
                Worksheets(2).Range("a2").Offset(k, 7) = wbk.Worksheets(Z).Range("d35").Offset(y, 7)
                Worksheets(2).Range("a2").Offset(k, 8) = wbk.Worksheets(Z).Range("d35").Offset(y, 9)
                Worksheets(2).Range("a2").Offset(k, 9) = wbk.Worksheets(Z).Range("d35").Offset(y, 14)
                Worksheets(2).Range("a2").Offset(k, 10) = wbk.Worksheets(Z).Range("d35").Offset(y, 15)

            k = k + 1
            Next

            
        Next 'worksheet
        wbk.Close
        End If
                      

   Next
    
End Sub