MPDK166
03-25-2011, 08:01 AM
I am creating a workbook (week report) which must be filled with data from other workbooks (day reports). The data I want to retrieve from the different day reports, must be set in the week report.
This is the script, i have got this far... There are still a lot of questions and challenges for me...
Option Explicit
Sub GetData()
Dim Extra As Integer
Dim cRange As Range
Dim FileValue
For Each cRange In Range("L2:R2")
For Extra = 0 To 6
FileValue = cRange
Dim FilePath$, Row&, Column&, Address$
Dim FileName$
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim sDay$
Dim sMonth$
Dim sYear$
Dim dtmDate As Date
dtmDate = cRange.Value
sDay = Format(Day(dtmDate), "00")
sMonth = Format(Month(dtmDate), "00")
sYear = Format(Year(dtmDate), "0000")
FileName$ = sDay & sMonth & sYear & ".xls"
Const SheetName$ = "Blad1"
Const NumRows& = 10
Const NumColumns& = 1
FilePath = fso.GetFolder(ThisWorkbook.path & "\..").path & "\Test1\"
DoEvents
Application.ScreenUpdating = False
If Dir(FilePath & FileName) = Empty Then
MsgBox "The file " & FileName & " was not found", , "File Doesn't Exist"
Exit Sub
End If
Dim cRow As Range
Dim CellValue
For Each cRow In Range("A1:A5, A8:A10")
Address = cRow.Address
CellValue = cRow.Address
Worksheets("Blad2").Range(CellValue).Offset(0, 1).Offset(0, Extra) = GetData(FilePath, FileName, SheetName, Address)
Next cRow
ActiveWindow.DisplayZeros = False
Next Extra
Next cRange
End Sub
Private Function GetData(path, file, sheet, Address)
Dim Data$
Data = "'" & path & "[" & file & "]" & sheet & "'!" & Range(Address).Range("A1").Address(, , xlR1C1)
GetData = ExecuteExcel4Macro(Data)
End Function
This is the script, i have got this far... There are still a lot of questions and challenges for me...
Option Explicit
Sub GetData()
Dim Extra As Integer
Dim cRange As Range
Dim FileValue
For Each cRange In Range("L2:R2")
For Extra = 0 To 6
FileValue = cRange
Dim FilePath$, Row&, Column&, Address$
Dim FileName$
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim sDay$
Dim sMonth$
Dim sYear$
Dim dtmDate As Date
dtmDate = cRange.Value
sDay = Format(Day(dtmDate), "00")
sMonth = Format(Month(dtmDate), "00")
sYear = Format(Year(dtmDate), "0000")
FileName$ = sDay & sMonth & sYear & ".xls"
Const SheetName$ = "Blad1"
Const NumRows& = 10
Const NumColumns& = 1
FilePath = fso.GetFolder(ThisWorkbook.path & "\..").path & "\Test1\"
DoEvents
Application.ScreenUpdating = False
If Dir(FilePath & FileName) = Empty Then
MsgBox "The file " & FileName & " was not found", , "File Doesn't Exist"
Exit Sub
End If
Dim cRow As Range
Dim CellValue
For Each cRow In Range("A1:A5, A8:A10")
Address = cRow.Address
CellValue = cRow.Address
Worksheets("Blad2").Range(CellValue).Offset(0, 1).Offset(0, Extra) = GetData(FilePath, FileName, SheetName, Address)
Next cRow
ActiveWindow.DisplayZeros = False
Next Extra
Next cRange
End Sub
Private Function GetData(path, file, sheet, Address)
Dim Data$
Data = "'" & path & "[" & file & "]" & sheet & "'!" & Range(Address).Range("A1").Address(, , xlR1C1)
GetData = ExecuteExcel4Macro(Data)
End Function