Auto Populate an excel sheet

[esdynamite]

Hi all,
my problem goes thus:
i get daily production reports in excel template which contains a lot of data, the data relevant to me is in some certain columns. I will like to have a new workbook where i can have those cells into whenever they come. I have a rule in outlook which extracts the attachments to a specified folder. The reports titles come as "DailyReport-020513.xls" . I will like the new work book to have dates and cells copied from all the reports received. So at the end of the month year, i can have a work book containing just that.
thanks for your help ..

[royUK]

You need to give more information - ranges to copy,sheet names, etc, if you want help.

[esdynamite]

thanks for the response,
the sheet names are sheet 1. that is the only sheet contained in each of the reports.
the cells to copy from each sheet.B7:AI8 (which contains the date, or if the date can be gotten off the title.) B19:AL29 ( actual values interested in).

[royUK]

Here's some code that you can adapt

Option Explicit
'---------------------------------------------------------------------------------------
' Module    : Data
' Author    : Roy Cox (royUK)
' Website   : for more examples and Excel Consulting
' Date      : 19/11/2011
' Purpose   : Combine data from several workbooks
' Disclaimer: Disclaimer; This code is offered as is with no guarantees. You may use it in your
'             projects but please leave this header intact.
 
'---------------------------------------------------------------------------------------


Option Explicit


Sub CombineData()
    Dim oWbk As Workbook
    Dim uRng As Range
    Dim rToCopy As Range
    Dim rNextCl As Range
    Dim lCount As Long
    Dim bHeaders As Boolean
    Dim sFil As String
    Dim sPath As String


    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
        '   On Error GoTo exithandler
        sPath = ThisWorkbook.Path & Application.PathSeparator & "Data"
        ChDir sPath
        sFil = Dir("*.xlsx")    'change or add formats
        Do While sFil <> ""    'will start LOOP until all files in folder sPath have been looped through


            With ThisWorkbook.Worksheets(1)
                Set uRng = .UsedRange
                If uRng.Cells.Count = 0 Then
                    'no data in master sheet
                    bHeaders = False
                Else: bHeaders = True
                End If


                Set oWbk = Workbooks.Open(sPath & Application.PathSeparator & sFil)    'opens the file
                Set rToCopy = oWbk.ActiveSheet.UsedRange
                If Not bHeaders Then
                    Set rNextCl = .Cells(1, 1)
                    bHeaders = True
                Else: Set rNextCl = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
                    'headers exist so don't copy
                    Set rToCopy = rToCopy.Offset(1, 0).Resize(rToCopy.Rows.Count - 1, _
                                                              rToCopy.Columns.Count)
                End If
                rToCopy.Copy rNextCl
            End With
            oWbk.Close False     'close source workbook
            sFil = Dir
        Loop    ' End of LOOP
        'sort to remove empty rows
        Set uRng = ThisWorkbook.Worksheets(1).UsedRange
        uRng.Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
                  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                  DataOption1:=xlSortNormal
exithandler:
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With
End Sub