Results 1 to 4 of 4

Thread: Auto Populate an excel sheet

  1. #1

    Question Auto Populate an excel sheet



    Register for a FREE account, and/
    or Log in to avoid these ads!

    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 ..

  2. #2
    Conjurer royUK's Avatar
    Join Date
    Mar 2011
    Location
    Derbyshire, UK
    Posts
    155
    Articles
    0
    Excel Version
    most versions
    You need to give more information - ranges to copy,sheet names, etc, if you want help.
    Hope that helps

    Roy

  3. #3
    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).

  4. #4
    Conjurer royUK's Avatar
    Join Date
    Mar 2011
    Location
    Derbyshire, UK
    Posts
    155
    Articles
    0
    Excel Version
    most versions
    Here's some code that you can adapt

    Code:
    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
    Hope that helps

    Roy

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •