Link to home
Start Free TrialLog in
Avatar of farmingtonis
farmingtonis

asked on

Combine specific worksheets into one

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
Avatar of Ardhendu Sarangi
Ardhendu Sarangi
Flag of United States of America image

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?
Avatar of farmingtonis
farmingtonis

ASKER

no i can't sorry.  never had to do that before but thanks.
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.
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.

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

      If Not SourceWorksheet Is ActiveSheet Then
to

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

ASKER CERTIFIED SOLUTION
Avatar of Dave
Dave
Flag of Australia image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Took a little tweaking on my part but good stuff.