Results 1 to 7 of 7
  1. #1
    New Lounger
    Join Date
    Sep 2004
    Posts
    4
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Extract Data From Multiple Sheets (xp)

    (Edited to make url clickable - see <!help=19>Help 19<!/help> and to remove lots of superfluous space - Mod)

    http://www.sbtankserve.com/SAMPLE.zip

    This is a SAMPLE excel file that I use to enter weekly data at work. Data for 5 days is entered for five days on five sheets

    DAY 1
    DAY 2
    DAY 3
    DAY 4
    DAY 5

    The first 7 rows are used for day specific calculations and column headers; Data is entered from the 7th row and below . The first column is used for day specific serial numbers. Maximum data range on any of the five Day pages is A1, L38. I want a simple formula/macro that will perform the following functions.

    --------------------------------------------------------------------------------------------------
    1) Copy all the data on the five sheets to a new sheet to a new sheet called "Consolidated"

    But the data must be only
    - Values,
    - Fonts and
    - Background cell colors only!
    --------------------------------------------------------------------------------------------------

    2) Create a new sheet called "Dispatches"

    This sheet must contain all the rows from ALL the FIVE sheets (Day 1, Day 2, Day 3, Day 4, and Day 5) that have entries in the DPS column

    But the
    - "Serial number" column HEADER must be replaced "Shift Date" and
    - Each respective "Serial Number" cell must represent the "Shift Date Value" from each respective page

    Basically creating a sheet with all the dispatches for the week

    --------------------------------------------------------------------------------------------------

    3) Create a new sheet called "Call Backs Made"

    This sheet must contain all the rows from ALL the FIVE sheets (Day 1, Day 2, Day 3, Day 4, and Day 5) that have entries in the "Phone Number" column

    But the
    - "Serial number" column HEADER must be replaced "Shift Date" and
    - Each respective "Serial Number" cell must represent the "Shift Date Value" from each respective page

    Basically creating a sheet with all the "Call Backs Made" for the week

    --------------------------------------------------------------------------------------------------

    4) Create a new sheet called "One Call's"

    This sheet must contain all the rows from ALL the FIVE sheets (Day 1, Day 2, Day 3, Day 4, and Day 5) that have entries in the "1 Call" column

    But the
    - "Serial number" column HEADER must be replaced "Shift Date" and
    - Each respective "Serial Number" cell must represent the "Shift Date Value" from each respective page

    Basically creating a sheet with all the "Call Backs Made" for the week

    --------------------------------------------------------------------------------------------------

    - Hyperdreamz

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Extract Data From Multiple Sheets (xp)

    Welcome to Woody's Lounge.

    As you must be aware, what you ask cannot be done with "a simple formula", or even with a simple macro. You're basically asking us to create a complete solution. That is beyond the scope of the Lounge - we give technical advice, and occasionally a bit more, but we do not write software solutions.

    You are welcome to post questions about specific parts of what you want to accomplish.

  3. #3
    New Lounger
    Join Date
    Sep 2004
    Posts
    4
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Extract Data From Multiple Sheets (xp)

    I understand ur point

    my request was rather blunt

    I apologize

    maybe somebody can help me with steps 2, 3, 4

    they are almost identical

    Any assistance is greatly appreciated

    - Hyperdreamz

  4. #4
    Uranium Lounger
    Join Date
    Jan 2001
    Location
    South Carolina, USA
    Posts
    7,295
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Extract Data From Multiple Sheets (xp)

    First, a comment about the macros that are in your workbook. You have a number of event routine macros in your workbook. Most of these macros have a line like this:

    <pre> On Error GoTo Errorhandler
    </pre>


    However, in the Errorhandler there is no Resume statement. When an error occurs in VBA, the VBA interpreter goes into what is called break mode. In break mode, many operations are illegal. If you handle errors by use of an On Error statement, you should ALWAYS us a Resume statement to exit from break mode after you have done what you want to recover from the error. Since I don't really know what you wanted to do, and since the Errorhandler routine does not contain any error handling code, I would guess that you did not really want to use the On Error GoTo Errorhandler. It looks like what you were really trying to do was cancel the previous On Error Resume Next. To do that you should have used On Error GoTo 0 (then number zero). You can also see this used in my code below.

    The code below does what you describe in your number 1. However, I am not convinced it does what you want.

    <pre>Public Sub Consolidate()
    Dim oTgtSh As Worksheet, oAS As Worksheet
    Dim I As Long, J As Long, K As Long
    Set oAS = ActiveSheet
    On Error Resume Next
    Set oTgtSh = Worksheets("Consolidate")
    On Error GoTo 0
    If oTgtSh Is Nothing Then
    Set oTgtSh = Worksheets.Add(After:=Worksheets(Worksheets.Count) )
    oTgtSh.Name = "Consolidate"
    oAS.Activate
    End If
    oTgtSh.Cells.Clear
    oTgtSh.Cells.ClearFormats
    K = 0
    With Worksheets("Day 1").Range("A7")
    For I = 0 To 29
    For J = 0 To 10
    oTgtSh.Range("A1").Offset(K, J).Value = .Offset(I, J).Value
    oTgtSh.Range("A1").Offset(K, J).Interior.ColorIndex = .Offset(I, J).Interior.ColorIndex
    oTgtSh.Range("A1").Offset(K, J).Font.Name = .Offset(I, J).Font.Name
    Next J
    K = K + 1
    Next I
    End With
    With Worksheets("Day 2").Range("A7")
    For I = 0 To 29
    For J = 0 To 10
    oTgtSh.Range("A1").Offset(K, J).Value = .Offset(I, J).Value
    oTgtSh.Range("A1").Offset(K, J).Interior.ColorIndex = .Offset(I, J).Interior.ColorIndex
    oTgtSh.Range("A1").Offset(K, J).Font.Name = .Offset(I, J).Font.Name
    Next J
    K = K + 1
    Next I
    End With
    With Worksheets("Day 3").Range("A7")
    For I = 0 To 29
    For J = 0 To 10
    oTgtSh.Range("A1").Offset(K, J).Value = .Offset(I, J).Value
    oTgtSh.Range("A1").Offset(K, J).Interior.ColorIndex = .Offset(I, J).Interior.ColorIndex
    oTgtSh.Range("A1").Offset(K, J).Font.Name = .Offset(I, J).Font.Name
    Next J
    K = K + 1
    Next I
    End With
    With Worksheets("Day 4").Range("A7")
    For I = 0 To 29
    For J = 0 To 10
    oTgtSh.Range("A1").Offset(K, J).Value = .Offset(I, J).Value
    oTgtSh.Range("A1").Offset(K, J).Interior.ColorIndex = .Offset(I, J).Interior.ColorIndex
    oTgtSh.Range("A1").Offset(K, J).Font.Name = .Offset(I, J).Font.Name
    Next J
    K = K + 1
    Next I
    End With
    With Worksheets("Day 5").Range("A7")
    For I = 0 To 29
    For J = 0 To 10
    oTgtSh.Range("A1").Offset(K, J).Value = .Offset(I, J).Value
    oTgtSh.Range("A1").Offset(K, J).Interior.ColorIndex = .Offset(I, J).Interior.ColorIndex
    oTgtSh.Range("A1").Offset(K, J).Font.Name = .Offset(I, J).Font.Name
    Next J
    K = K + 1
    Next I
    End With
    End Sub
    </pre>

    Legare Coleman

  5. #5
    New Lounger
    Join Date
    Sep 2004
    Posts
    4
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Extract Data From Multiple Sheets (xp)

    Edited to get rid of superfluous blank lines. Please avoid using so many blank lines - Mod

    Thanks for the prompt reply. Kindly feel free to get rid off the existing macros. The macro u posted worked like a charm. However like u suspected it's not the desired output L. Basic logic for step 1 is
    -----------------------------------------------------------------------------
    Create new sheet called "Consolidated"

    Go to sheet "Day 1"
    Select range "A1:L38"
    Copy
    Go to sheet "Consolidated"
    Go to first available free cell in column A$
    Paste

    Go to sheet "Day 2"
    Select range "A1:L38"
    Copy
    Go to sheet "Consolidated"
    Go to first available free cell in column A$
    Paste

    Go to sheet "Day 3"
    Select range "A1:L38"
    Copy
    Go to sheet "Consolidated"
    Go to first available free cell in column A$
    Paste

    Go to sheet "Day 4"
    Select range "A1:L38"
    Copy
    Go to sheet "Consolidated"
    Go to first available free cell in column A$
    Paste

    Go to sheet "Day 5"
    Select range "A1:L38"
    Copy
    Go to sheet "Consolidated"
    Go to first available free cell in column A$
    Paste

    Go to sheet "Weekly Total"
    Select range "A1:G20"
    Copy
    Go to sheet "Consolidated"
    Go to first available free cell in column A$
    Paste
    End
    -----------------------------------------------------------------------------
    Think this is possible. Instead of a macro maybe a array formula ?

    Regards,
    Hyperdreamz

  6. #6
    Uranium Lounger
    Join Date
    Jan 2001
    Location
    South Carolina, USA
    Posts
    7,295
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Extract Data From Multiple Sheets (xp)

    Ok, does this doe what you want, or did you really want to paste values as in your first note? If you do want to paste values, do you also want to paste the formats?

    <pre>Public Sub Consolidate()
    Dim oTgtSh As Worksheet, oAS As Worksheet
    Set oAS = ActiveSheet
    On Error Resume Next
    Set oTgtSh = Worksheets("Consolidate")
    On Error GoTo 0
    If oTgtSh Is Nothing Then
    Set oTgtSh = Worksheets.Add(After:=Worksheets(Worksheets.Count) )
    oTgtSh.Name = "Consolidate"
    oAS.Activate
    End If
    oTgtSh.Cells.Clear
    Worksheets("Day 1").Range("A1:L38").Copy
    oTgtSh.Paste Destination:=oTgtSh.Range("A1")
    Worksheets("Day 2").Range("A1:L38").Copy
    oTgtSh.Paste Destination:=oTgtSh.Range("A39")
    Worksheets("Day 3").Range("A1:L38").Copy
    oTgtSh.Paste Destination:=oTgtSh.Range("A77")
    Worksheets("Day 4").Range("A1:L38").Copy
    oTgtSh.Paste Destination:=oTgtSh.Range("A115")
    Worksheets("Day 5").Range("A1:L38").Copy
    oTgtSh.Paste Destination:=oTgtSh.Range("A153")
    oTgtSh.Range("A:L").EntireColumn.AutoFit
    Application.CutCopyMode = xlCopy
    End Sub
    </pre>

    Legare Coleman

  7. #7
    New Lounger
    Join Date
    Sep 2004
    Posts
    4
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Extract Data From Multiple Sheets (xp)

    (Edited by HansV to make URL clickable - see <!help=19>Help 19<!/help>)

    thanks for the reply

    all the help is apriciated

    but i think i got the problem licked @ another forum

    couple a bugs but have them ironed out soon

    if care to have a look

    http://www.ozgrid.com/forum/showthread.php...age=1&pp=10

    -Hyperdreamz

Posting Permissions

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