Results 1 to 6 of 6
  1. #1
    Join Date
    Dec 2006

    Unanswered: Adding worksheet data into another


    Can someone show me a simple way to pull expandable worksheet data to a main worksheet. I've got mutiple sites broken down by worksheets. These rows and columns continually change, but the column headings match the main worksheet. What I need this to do is populate each individual worksheets data rows into their corresponding area on the "main" consolidate worksheet without lapping over the others. See screenshots.

    Any advice or input is greatly appreciated!


    Attached Thumbnails Attached Thumbnails Main.JPG   Site3.JPG   Merged.JPG  

  2. #2
    Join Date
    Apr 2004
    Derbyshire, UK
    Provided Answers: 1

    Yes this is definity possible, but you need to ensure that the column heading are the same (and in the same row to simplify things, but even this can be worked round) and the Site sheet names always match the site lables in 'New Main' column A.

    However, one question first, is the 'New Main' always devoid of data before this routine to copy the data is run, and will the sites lables be separated by at least one row between them?


  3. #3
    Join Date
    Dec 2006


    Hi Mike,

    1st off - thanks for responding.

    To answer your question, which I'm hoping I understand correctly, the data on the Main worksheet is to stay there and resize according to row entries - without overlapping the other site location data.
    Site separation with at least one row between them is not definite. It doesn't have to be that way. I was just trying to give it some sort of separation.


  4. #4
    Join Date
    Apr 2010
    This isn't to bad. I had to do some similar stuff a couple of weeks ago.

    Create an ActiveX button on New Main, right click, go to code, copy paste

    I wrote this to be fairly intuative, so you should be able to add columns, etc without getting into the code.


    Private Sub CommandButton1_Click()

    Application.ScreenUpdating = False

    On Error Resume Next

    currentsheetname = ActiveSheet.Name

    'Loop through all of the Sites and put data in the current one
    For i = 1 To Worksheets.Count

    With Worksheets(currentsheetname)
    'Looks on the current sheet for the Site #
    siterowa = .Cells.Find(what:="Site " & i, After:=Range(Cells(1, 1).Address), LookIn:=xlValues, LookAt:= _
    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
    , SearchFormat:=False).Row

    'Looks for the next site
    siterowb = .Cells.Find(what:="Site " & i + 1, After:=Range(Cells(1, 1).Address), LookIn:=xlValues, LookAt:= _
    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
    , SearchFormat:=False).Row

    'Checks to see if Site Row B has noting (end of data)
    If Not siterowb Is Empty Then
    .Range(Cells(siterowa, 1), Cells(siterowb - 2, 1)).EntireRow.Delete
    .Range(Cells(siterowa, 1), Cells(UsedRange.Rows.Count, 1)).EntireRow.Delete
    End If

    End With

    lookingforsheet = "Site " & i

    'Go through the Site sheet and grab the data
    With Worksheets(lookingforsheet)
    siterowc = .Cells.Find(what:="Site " & i, After:=Range(Cells(1, 1).Address), LookIn:=xlValues, LookAt:= _
    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
    , SearchFormat:=False).Row

    .Range(Cells(siterowc, 1), Cells(UsedRange.Rows.Count, 1)).EntireRow.Copy
    End With

    'Paste the new data
    Worksheets(currentsheetname).Cells(siterowa, 1).EntireRow.Insert

    Next i

    Application.ScreenUpdating = True

    End Sub


  5. #5
    Join Date
    Dec 2006

    The code doesn't work...I forgot to mention sumthing

    Each tab/worksheet is named with a separate address.

    The references on the main sheet match.

    site 1 = 1234 Lexiongton Way
    site 2 = 4321 Trucker Ave.

  6. #6
    Join Date
    Sep 2008
    London, UK
    Hi Mill,

    If the summary sheet is for viewing purposes only then another option might be to use the camera tool. I've not used it much but I had a quick go and the results seemed to be fairly satisfactory; I have attached an example based on your screenshots in post #1.

    In the example there are three "Site" worksheets with identical layouts. Note that the column widths, column headers, row heights, zoom etc... are the same on all the sheets.

    On the summary worksheet, "New Main", I have added an identical layout with headers but less the data. I then used the camera tool to take a snapshot of each site sheet and added the snap shots onto the "New Main" worksheet. I renamed each snapshot picture so it has the same name as its corresponding worksheet.

    The camera tool is a synchronised snap shot with its corresponding range, so if you update something in the range, the picture will automatically update. However, there are two problems: the snapshot picture will not expand if you update a cell outside of the snapshot range and, even if it did expand, the snapshots would end up overlapping each other.

    To ensure that the snapshot captures the entire used range, I decided to use some dynamic named ranges in preference to VBA. In my example, column C containing the Sub Project always has an entry in the last row, so the named formulas for each sheet are:
    Site1Area =OFFSET('Site 1'!$A$2,0,0,MATCH("*",'Site 1'!$C:$C,-1),8)
    Site2Area =OFFSET('Site 2'!$A$2,0,0,MATCH("*",'Site 2'!$C:$C,-1),8)
    Site3Area =OFFSET('Site 3'!$A$2,0,0,MATCH("*",'Site 3'!$C:$C,-1),8)

    These formulas return the used range from columns A:H plus one empty row. I selected each picture and added formulas to reference them:

    To address the issue of the snapshots overlapping when they expand (or becoming to spaced as they contract), first of all I tried to group the pictures. Unfortunately grouping them just meant that the shapes stayed the same size and each image was squashed or stretched to fit its frame. There might be a better way to do this, but to address this problem I ended up using a little VBA.

    Firstly in the ThisWorkbook class module I use an event handler to know when some project details have been added, amended or removed:
    Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
        If Sh.Name <> "New Main" Then Sheet1.MovePictures
    End Sub

    Then in the New Main worksheet class module, some code to make sure each snapshot captures the entire used range of each sheet plus some code to align the snapshots correctly:
    Option Explicit
    Public Sub MovePictures()
        Const strPICTURE As String = "Picture"
        Dim shpPicture As Shape
        Dim shpLast As Shape
        On Error GoTo ErrorHandler
        AppSettings False
        'make sure the pictures are properly aligned
        For Each shpPicture In Me.Shapes
            If TypeName(shpPicture.DrawingObject) = strPICTURE Then
                If shpPicture.ZOrderPosition = 1 Then
                    shpPicture.Top = Range("A2").Top
                    shpPicture.Top = Range("A" & (shpLast.BottomRightCell.Row)).Top
                End If
                shpPicture.Left = Range("A2").Left
                Set shpLast = shpPicture
            End If
        Next shpPicture
        On Error Resume Next
        AppSettings True
        Exit Sub
        Debug.Print Err.Number & vbNewLine & Err.Description
        Resume ErrorExit
    End Sub
    Private Sub AppSettings(ByVal blnOn As Boolean)
        Application.ScreenUpdating = blnOn
        Application.EnableEvents = blnOn
        Application.DisplayAlerts = blnOn
    End Sub
    This is a pretty basic, generic set-up, but with some work to make it more robust it might just work for you.

    Hope that helps...
    Attached Files Attached Files

Posting Permissions

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