Combine multiple sheets into one sheet?

B

Blueluck

I have a spreadsheet with about 200 sheets in it, and I would like to have
all of the data on one sheet. All of the sheets are formatted the same, with
identical column headings but different data on each row.

Without cutting and pasting 200 times, how can I get all of my rows onto one
worksheet?

Thank your for any help,
Steve
 
M

Mangesh Yadav

Well, the safest way is to have a small macro do it, but since you have
posted this in the misc section, if you give details as to the sheet names,
the number of rows in each sheet, then with a formula you could simply drag
down and copy in the summary sheet, and then drag right to copy the columns.

Mangesh
 
P

Pank

Blueluck,

I asked the same question some time again as was assisted by a gentleman
call Dave Peterson (Thanks Dave)

Dave kindly supplied the following which I am sure will do the job that you
want.

I have inserted comments which start ===READ, which you will have to review
and take the necessary action(s).

To copy the macro, open up your workbook, depress ALT+F8, call the macro
merging copy it and run it.

Good Luck

HTH

Pank


Sub Merging()

Dim wks As Worksheet
Dim DestCell As Range
Dim newWks As Worksheet
Dim HeadersAreDone As Boolean
Dim mySelectedSheets As Object
Dim myRngToCopy As Range

Set mySelectedSheets = ActiveWindow.SelectedSheets
ActiveWorkbook.Worksheets(1).Select


‘===Read Iin my example I only wanted to merge 3 sheets.
‘If you want all sheets select the first sheet tab depress the right mouse
key and select ALL SHEETS. Get rid of the following if up to the endif

If mySelectedSheets.Count <> 3 Then
MsgBox "Please Group exactly 3 sheets before you run this macro!"
Exit Sub
End If

'MsgBox "Merging selected spreadsheets into 1 sheet - Select OK"

Set newWks = Workbooks.Add(1).Worksheets(1)

HeadersAreDone = False

‘in my example my worksheet was protected and hence the following statement.
ActiveWorkbook.Unprotect

For Each wks In mySelectedSheets
With wks
If HeadersAreDone = True Then
'do nothing
Else
‘===Read In my example I had headings in rows 1 & 2,
'for both rows 1 & 2, use .rows("1:2").copy _
'instead of the next line
.Rows(2).Copy _
Destination:=newWks.Range("a1")
HeadersAreDone = True
Set DestCell = newWks.Range("a2")
End If

‘===Read In my example my worksheet was protected and hence the following
statement (i.e just unprotect.)

.Unprotect Password:=""
.Range("a3", .Cells.SpecialCells(xlCellTypeLastCell)).Copy
DestCell.PasteSpecial Paste:=xlPasteValues
.Protect Password:=""

With newWks
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

End With
Next wks
End Sub
 
Top