Results 1 to 4 of 4
  1. #1
    New Lounger
    Join Date
    May 2010
    Location
    Melbourne, Australia
    Posts
    13
    Thanks
    1
    Thanked 0 Times in 0 Posts

    Excel 2010: Copy from all worksheets to one worksheet

    I need to be able to step through all worksheets in a workbook and copy each worksheet's named range content to a consolidation worksheet named Master, for eaxample.

    Worksheet1 has range name Accruals currently (C2:J4) but could be any range
    Org Fund CC Acct Proj Cr Desc
    7002 3001 6521 18039 X0000000 12 test1
    7002 3001 6523 18039 X0000000 12 test1
    7002 3001 6522 18039 X0000000 12 test1


    Worksheet2 has range name Accruals currently (C2:J4) but could be any range
    Org Fund CC Acct Proj Cr Desc
    7002 3001 6521 18039 X0000000 12 test2
    7002 3001 6523 18039 X0000000 12 test2
    7002 3001 6522 18039 X0000000 12 test2


    Worksheet3 has range name Accruals currently (C2:J4) but could be any range
    Org Fund CC Acct Proj Cr Desc
    7002 3001 6521 18039 X0000000 12 test3
    7002 3001 6523 18039 X0000000 12 test3
    7002 3001 6522 18039 X0000000 12 test3

    The output in the Master worksheet should look like this:
    Org Fund CC Acct Proj Cr Desc
    7002 3001 6521 18039 X0000000 12 test1
    7002 3001 6523 18039 X0000000 12 test1
    7002 3001 6522 18039 X0000000 12 test1
    7002 3001 6521 18039 X0000000 12 test2
    7002 3001 6523 18039 X0000000 12 test2
    7002 3001 6522 18039 X0000000 12 test2
    7002 3001 6521 18039 X0000000 12 test3
    7002 3001 6523 18039 X0000000 12 test3
    7002 3001 6522 18039 X0000000 12 test3


    Any suggestions very gratefully received.

    Thanks in advance

  2. #2
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,436
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    aardvarck,

    Here's a little VBA that will do the trick. Of course you may need to make some adjustments if for example your Master has a header row but it should be easy to figure out if your read the code.
    Code:
    Option Explicit
    
    Sub CombineRanges()
    
       Dim lLastRow As Long
       Dim sht      As Worksheet
       Dim lRowCnt  As Long
       
       lLastRow = 1
       [A1].Select
       
       For Each sht In ActiveWorkbook.Worksheets
       
          If sht.Name <> "Master" Then
          
            lRowCnt = sht.Range("Accruals").Rows.Count
            sht.Range("Accruals").Copy
            ActiveSheet.Paste
            lLastRow = lLastRow + lRowCnt
            Cells(lLastRow, 1).Select
          
          End If
          
       Next sht
       
    End Sub
    
    Sub ClearMaster()
    
       Worksheets("Master").Activate
       Range([A1], [A1].SpecialCells(xlLastCell)).ClearContents
       
    End Sub
    BTW: I hope you're using 2007 or 2010 as I couldn't find a way to create Range Names with worksheet scope in 2003 w/o using an addin.
    Attached Files Attached Files
    Last edited by RetiredGeek; 2012-06-05 at 21:36.
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  3. #3
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,436
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    New and improved version with error checking.
    Code:
    Option Explicit
    
    Sub CombineRanges()
    
       Dim lLastRow    As Long
       Dim sht         As Worksheet
       Dim lRowCnt     As Long
       Dim bMissingRng As Boolean
       
       ClearMaster    'Clear the Master worksheet
       lLastRow = 1
       bMissingRng = False
       [A1].Select
       
       For Each sht In ActiveWorkbook.Worksheets
       
          If sht.Name <> "Master" Then
            On Error GoTo NoRangeNameOnSheet
            lRowCnt = sht.Range("Accruals").Rows.Count
            On Error GoTo 0
            If Not bMissingRng Then
              sht.Range("Accruals").Copy
              ActiveSheet.Paste
              lLastRow = lLastRow + lRowCnt
              Cells(lLastRow, 1).Select
            End If   'Not bMissingRng
            bMissingRng = False  'Reset for next loop
          End If     'sht.Name <> "Master"
          
       Next sht
       
    GoTo ExitCombineRanges
    
    NoRangeNameOnSheet:
      '*** Note Error Handler only covers missing range name error!!!
      If Err = 1004 Then
        bMissingRng = True
        MsgBox "Worksheet: " & sht.Name & " does not contain " & _
               "the Range Name Accruals!", _
               vbOKOnly + vbInformation, "Error: No Range Name Found"
        Resume Next
      Else
        MsgBox "Error:       " & Err & vbCrLf & _
               "Description: " & Err.Description
        Resume Next
      End If
             
    ExitCombineRanges:
    
    End Sub
    
    Sub ClearMaster()
    
       Worksheets("Master").Activate
       Range([A1], [A1].SpecialCells(xlLastCell)).ClearContents
       
    End Sub
    Attached Files Attached Files
    Last edited by RetiredGeek; 2012-06-06 at 16:06.
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  4. #4
    New Lounger
    Join Date
    May 2010
    Location
    Melbourne, Australia
    Posts
    13
    Thanks
    1
    Thanked 0 Times in 0 Posts
    Many thanks for the code.
    I'll try it out later today (Melbourne Australia time)
    Regards

Posting Permissions

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