Solved

Combine specific worksheets into one

Posted on 2011-03-25
9
532 Views
Last Modified: 2012-05-11
I have a number of tabs that i need to combine into one.  There are a total of 9 tabs and I only need 8.  I have created a tab called 'combine' to accept all of the data but i need to not pull in the data from a tab named 'summary'.  how do you combine specific tabs?  

thanks
0
Comment
Question by:farmingtonis
  • 4
  • 2
  • 2
  • +1
9 Comments
 
LVL 20

Expert Comment

by:pari123
ID: 35218145
either you can copy and paste data from different sheets into one manually or you can use a macro. but to create a macro, it would require to see the original spreadsheet and the expected result. can you please post a sample file here?
0
 

Author Comment

by:farmingtonis
ID: 35218170
no i can't sorry.  never had to do that before but thanks.
0
 

Author Comment

by:farmingtonis
ID: 35218174
oh, but i can tell you there are a total of 33 columns and the rows counts are variable.  does that help?  Each sheet should be placed on the other then without the header one after the other.
0
 
LVL 20

Expert Comment

by:pari123
ID: 35218200
sorry but your requirements seem a bit vague to me.

its hard to understand when you say combine, do you mean to copy over each tab to the left of the other tabs..so columns 1 thru 33 are sheet 1, 34 thru 66 are sheet 2 and so on

or you want to copy and paste the data one below the other..

unless you have a spreadsheet, its too difficult for me to even start something. you can provide a dummy file, need not be the actual data in it.

0
Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

 
LVL 43

Expert Comment

by:Saqib Husain, Syed
ID: 35218240
Try this macro. This is the best I can do without a sample.

Saqib

Sub combsheets()
Set ts = Worksheets("Combine")
For Each ws In ThisWorkbook.Worksheets
If LCase(ws.Name) <> "combine" And LCase(ws.Name) <> "summary" Then
ws.UsedRange.Copy ts.Cells(ts.UsedRange.Row + ts.UsedRange.Rows.Count, 1)
End If
Next ws
End Sub
0
 

Author Comment

by:farmingtonis
ID: 35218362
It only gets the first row.  Below is the code that pulls in all of the data from each sheet.

Public Function STEP1()
 
   Dim SourceWorksheet As Worksheet
   Dim SourceRange As Range
   Dim DestRow As Long
   
   ' Change the following constant if the first source row is not row 2 on each worksheet
   Const FirstSourceRow = 1
   
   Application.ScreenUpdating = False
   
   DestRow = IIf(Sheet1.UsedRange.Address = "$A$1", 1, Sheet1.UsedRange.SpecialCells(xlLastCell).Row + 1)
   For Each SourceWorksheet In ThisWorkbook.Worksheets
      If Not SourceWorksheet Is ActiveSheet Then
         If SourceWorksheet.UsedRange.Rows.Count >= FirstSourceRow Then
            Set SourceRange = SourceWorksheet.UsedRange.Offset(FirstSourceRow - 1).Resize(SourceWorksheet.UsedRange.Rows.Count - FirstSourceRow + 1)
            Sheet1.Rows(DestRow).Resize(SourceRange.Rows.Count, SourceRange.Columns.Count).Value = SourceRange.Value
            SourceRange.Copy
            Sheet1.Rows(DestRow).Resize(SourceRange.Rows.Count, SourceRange.Columns.Count).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
            DestRow = DestRow + SourceRange.Rows.Count
         End If
      End If
   Next SourceWorksheet
   
   Application.ScreenUpdating = True
 
End Function
0
 
LVL 43

Expert Comment

by:Saqib Husain, Syed
ID: 35218382
Change

      If Not SourceWorksheet Is ActiveSheet Then
to

If Not SourceWorksheet Is ActiveSheet and LCase(ws.Name) <> "summary" Then

0
 
LVL 50

Accepted Solution

by:
Dave Brett earned 250 total points
ID: 35219878
My Article offers this abilityto do this  http://www.experts-exchange.com/A_2804.htm
(ie iii below)
                 i. Collate all sheets from all Excel workbooks in a single folder into a single summary worksheet
                 ii. Collate all sheets from all Excel workbooks in a single folder into a single summary workbook
                iii. Collate all sheets from a single Excel workbook into a single summary worksheet

I have changed this line below to avoid the summary page
 If Not rng2 Is Nothing and ws2.name <> "summary" Then

Cheers

Dave
Public Sub ConsolidateSheets()
    Dim Wb1 As Workbook
    Dim Wb2 As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    Dim rng1 As Range
    Dim rng2 As Range
    Dim rng3 As Range
    Dim rngArea As Range
    Dim lrowSpace As Long
    Dim lSht As Long
    Dim lngCalc As Long
    Dim lngRow As Long
    Dim lngCol As Long
    Dim X()
    Dim bProcessFolder As Boolean
    Dim bNewSheet As Boolean

    Dim StrPrefix
    Dim strFileName As String
    Dim strFolderName As String

    'variant declaration needed for the Shell object to use a default directory
    Dim strDefaultFolder As Variant


 bProcessFolder = (MsgBox("Process a single folder (Yes)," & vbNewLine & "or single file (No)", vbYesNo, "Application Scope: Folder or single File") = vbYes)
    bNewSheet = (MsgBox("Extract all data to a single sheet (TRUE)," & vbNewLine & "or a target file sheet for each source sheet(FALSE)", vbYesNo, "Output Format: Single sheet or sheet by sheet collection") = vbYes)
    If Not bProcessFolder Then
        If Not bNewSheet Then
            MsgBox "There isn't much point creating a exact replica of your source file :)"
            Exit Sub
        End If
    End If

    'set default directory here if needed
    strDefaultFolder = "C:\temp"

    'If the user is collating all the sheets to a single target sheet then the row spacing
    'to distinguish between different sheets can be set here
    lrowSpace = 1

    If bProcessFolder Then
        strFolderName = BrowseForFolder(strDefaultFolder)
        'Look for xls, xlsx, xlsm files
        strFileName = Dir(strFolderName & "\*.xls*")
    Else
        strFileName = Application _
                      .GetOpenFilename("Select file to process (*.xls), *.xls")
    End If

    Set Wb1 = Workbooks.Add(1)
    Set ws1 = Wb1.Sheets(1)
    If Not bNewSheet Then ws1.Range("A1:B1") = Array("workbook name", "worksheet count")

    'Turn off screenupdating, events, alerts and set calculation to manual
    With Application
        .DisplayAlerts = False
        .EnableEvents = False
        .ScreenUpdating = False
        lngCalc = .Calculation
        .Calculation = xlCalculationManual
    End With

    'set path outside the loop
    StrPrefix = strFolderName & IIf(bProcessFolder, "\", vbNullString)

    Do While Len(strFileName) > 0
        'Provide progress status to user
        Application.StatusBar = Left("Processing " & strFolderName & "\" & strFileName, 255)
        'Open each workbook in the folder of interest
        Set Wb2 = Workbooks.Open(StrPrefix & strFileName)
        If Not bNewSheet Then
            'add summary details to first sheet
            ws1.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) = Wb2.Name
            ws1.Cells(Rows.Count, "A").End(xlUp).Offset(0, 1) = Wb2.Sheets.Count
        End If
        For Each ws2 In Wb2.Sheets
            If bNewSheet Then
                'All data to a single sheet
                'Skip importing target sheet data if the source sheet is blank
                Set rng2 = ws2.Cells.Find("*", ws2.[a1], xlValues, , xlByRows, xlPrevious)

                If Not rng2 Is Nothing And ws2.Name <> "summary" Then
                    Set rng1 = ws1.Cells.Find("*", ws1.[a1], xlValues, , xlByRows, xlPrevious)
                    'Find the first blank row on the target sheet
                    If Not rng1 Is Nothing Then
                        Set rng3 = ws2.Range(ws2.UsedRange.Cells(1), ws2.Cells(rng2.Row, "A"))
                        'Ensure that the row area in the target sheet won't be exceeded
                        If rng3.Rows.Count + rng1.Row < Rows.Count Then
                            'Copy the data from the used range of each source sheet to the first blank row
                            'of the target sheet, using the starting column address from the source sheet being copied
                            ws2.UsedRange.Copy ws1.Cells(rng1.Row + 1 + lrowSpace, ws2.UsedRange.Cells(1).Column)
                        Else
                            MsgBox "Summary sheet size exceeded. Process stopped on " & vbNewLine & _
                                   "sheet: " & ws2.Name & vbNewLine & "of" & vbNewLine & "workbook: " & Wb2.Name
                            Wb2.Close False
                            Exit Do
                        End If
                        'colour the first of any spacer rows
                        If lrowSpace <> 0 Then ws1.Rows(rng1.Row + 1).Interior.Color = vbGreen
                    Else
                        'target sheet is empty so copy to first row
                        ws2.UsedRange.Copy ws1.Cells(1, ws2.UsedRange.Cells(1).Column)
                    End If
                End If
            Else
                'new target sheet for each source sheet
                ws2.Copy after:=Wb1.Sheets(Wb1.Sheets.Count)
                'Remove any links in our target sheet
                With Wb1.Sheets(Wb1.Sheets.Count).Cells
                    .Copy
                    .PasteSpecial xlPasteValues
                End With
                On Error Resume Next
                Wb1.Sheets(Wb1.Sheets.Count).Name = ws2.Name
                'sheet name already exists in target workbook
                If Err.Number <> 0 Then
                    'Add a number to the sheet name till a unique name is derived
                    Do
                        lSht = lSht + 1
                        Set ws3 = Wb1.Sheets(ws2.Name & " " & lSht)
                    Loop While Not ws3 Is Nothing
                    lSht = 0
                End If
                On Error GoTo 0
            End If
        Next ws2
        'Close the opened workbook
        Wb2.Close False
        'Check whether to force a DO loop exit if processing a single file
        If bProcessFolder = False Then Exit Do
        strFileName = Dir
    Loop

    'Remove any links if the user has used a target sheet
    If bNewSheet Then
        With ws1.UsedRange
            .Copy
            .Cells(1).PasteSpecial xlPasteValues
            .Cells(1).Activate
        End With
    Else
        'Format the summary sheet if the user has created separate target sheets
        ws1.Activate
        ws1.Range("A1:B1").Font.Bold = True
        ws1.Columns.AutoFit
    End If

    With Application
        .CutCopyMode = False
        .DisplayAlerts = True
        .EnableEvents = True
        .ScreenUpdating = True
        .Calculation = lngCalc
        .StatusBar = vbNullString
    End With
End Sub


Function BrowseForFolder(Optional OpenAt As Variant) As Variant
'From Ken Puls as used in his vbaexpress.com article
'http://www.vbaexpress.com/kb/getarticle.php?kb_id=284

    Dim ShellApp As Object
    'Create a file browser window at the default folder
    Set ShellApp = CreateObject("Shell.Application"). _
                   BrowseForFolder(0, "Please choose a folder", 0, OpenAt)

    'Set the folder to that selected.  (On error in case cancelled)
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0

    'Destroy the Shell Application
    Set ShellApp = Nothing

    'Check for invalid or non-entries and send to the Invalid error
    'handler if found
    'Valid selections can begin L: (where L is a letter) or
    '\\ (as in \\servername\sharename.  All others are invalid
    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = ":"
        If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
    Case Is = "\"
        If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
    Case Else
        GoTo Invalid
    End Select

    Exit Function

Invalid:
    'If it was determined that the selection was invalid, set to False
    BrowseForFolder = False
End Function

Open in new window

0
 

Author Closing Comment

by:farmingtonis
ID: 35512869
Took a little tweaking on my part but good stuff.
0

Featured Post

Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

Join & Write a Comment

Improved? Move/Copy Add-in Replacement - How to avoid the annoying, “A formula or sheet you want to move or copy contains the name XXX, which already exists on the destination worksheet.” David Miller (dlmille)  It was one of those days… I wa…
Using Word 2013, I was experiencing some incredible lag when typing.  Here's what worked for me....
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

757 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now