PDA

View Full Version : pulling data from different reports into master workbook



forbzinator
12-01-2011, 01:04 AM
I have been asked to create a dashboard at work which consists of data from around 15 different reports.

Each of these reports are released daily with their own unique naming structure.

I will use one of the reports as an example:

"operational dashboard Wk19 15-11-11.xls"
"operational dashboard Wk19 16-11-11.xls"
"operational dashboard Wk20 17-11-11.xls"
"operational dashboard Wk20 18-11-11.xls"
"operational dashboard Wk20 19-11-11.xls"

What I need from each report is one particular worksheet which always has exactly the same name "data sheet agent"

I would like the worksheet "data sheet agent" from each workbook to be extracted from here into my master spreadsheet and then renamed to the workbook it was taken from (the week number is the important thing for me not the date at the end as its a cumulative report as each report contains all the data that the previous reports from the same week have in)

It would be ideal if the import side of it was using a browse option so the file was selected manually or if it could be automated using the date in the filename so it only takes the most recent from each week per report.

Is this something one of you coding guru's could assist me with as I am totally stumped!!!!

As you can probably tell I am quite new to VBA so would really appreciate your help.

Excel 2007 being used.

Many thanks.

mdmackillop
12-01-2011, 02:21 PM
Option Explicit

Sub Gather()
Dim wbTgt As Workbook
Dim wb As Workbook
Dim Fil As String
Dim x As String, y As String
Dim i As Long
Dim Chk As Boolean

Set wbTgt = ThisWorkbook
Fil = "C:\AAA\operational dashboard Wk"

For i = 1 To 52
Chk = False
y = ""
x = Dir(Fil & i & " *.xls")
Do Until x = ""
Debug.Print x
If x > y Then y = x
x = Dir
Chk = True
Loop
If Chk Then
Set wb = Workbooks.Open("C:\AAA\" & y)

wb.Sheets("data sheet agent").Copy Before:=wbTgt.Sheets(1)
ActiveSheet.Name = "Week" & i
'For checking
ActiveSheet.Cells(1, 1) = y
'End check
wb.Close False
End If
Next
End Sub