How to merge several pages of one workbook together?

[sivanandan dinesh]

HOW TO MERGE SEVERAL PAGES OF ONE WORKBOOK TOGETHER?

I HAVE A WORK BOOK WITH 45PAGES. I NEED IT TO BE IN JUST ONE PAGE. HOW TO MERGE THIS WITHOUT CUTTING AND PASTING?

 

[Joseph.Marro]

sivanandan,

Please note, this sub is written prior to the release of XL 2007. If your worksheets contain more than 255 columns and 65536 rows the code will need to be modified to handle the new limits. This is also true if the combined total of all worksheets exceeds 255 columns and 65536 rows.

The following code was retrieved from:
http://www.vbaexpress.com/kb/getarticle.php?kb_id=151

[COLOR=#0000ff]Sub[/COLOR] CopyFromWorksheets() 
    [COLOR=blue]Dim[/COLOR] wrk [COLOR=blue]As[/COLOR] Workbook [COLOR=darkgreen]'Workbook object - Always good to work with object variables[/COLOR]
    [COLOR=blue]Dim[/COLOR] sht [COLOR=blue]As[/COLOR] Worksheet [COLOR=darkgreen]'Object for handling worksheets in loop[/COLOR]
    [COLOR=blue]Dim[/COLOR] trg [COLOR=blue]As[/COLOR] Worksheet [COLOR=darkgreen]'Master Worksheet[/COLOR]
    [COLOR=blue]Dim[/COLOR] rng [COLOR=blue]As[/COLOR] Range [COLOR=darkgreen]'Range object[/COLOR]
    [COLOR=blue]Dim[/COLOR] colCount [COLOR=blue]As[/COLOR] [COLOR=blue]Integer[/COLOR] [COLOR=darkgreen]'Column count in tables in the worksheets[/COLOR]
 
    [COLOR=blue]Set[/COLOR] wrk = ActiveWorkbook [COLOR=darkgreen]'Working in active workbook[/COLOR]
 
    [COLOR=blue]For Each[/COLOR] sht [COLOR=blue]In[/COLOR] wrk.Worksheets 
        [COLOR=blue]If[/COLOR] sht.Name = "Master" [COLOR=blue]Then[/COLOR] 
            MsgBox "There is a worksheet called as 'Master'." & vbCrLf & _ 
            "Please remove or rename this worksheet since 'Master' would be" & _ 
            "the name of the result worksheet of this process.", vbOKOnly + vbExclamation, "Error" 
            Exit [COLOR=blue]Sub[/COLOR] 
        [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR] 
    [COLOR=blue]Next[/COLOR] sht 
 
     [COLOR=darkgreen]'We don't want screen updating[/COLOR]
    Application.ScreenUpdating = [COLOR=blue]False[/COLOR] 
 
     [COLOR=darkgreen]'Add new worksheet as the last worksheet[/COLOR]
    [COLOR=blue]Set[/COLOR] trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count)) 
     [COLOR=darkgreen]'Rename the new worksheet[/COLOR]
    trg.Name = "Master" 
     [COLOR=darkgreen]'Get column headers from the first worksheet[/COLOR]
     [COLOR=darkgreen]'Column count first[/COLOR]
    [COLOR=blue]Set[/COLOR] sht = wrk.Worksheets(1) 
    colCount = sht.Cells(1, 255).End(xlToLeft).Column 
     [COLOR=darkgreen]'Now retrieve headers, no copy&paste needed[/COLOR]
    [COLOR=blue]With[/COLOR] trg.Cells(1, 1).Resize(1, colCount) 
        .Value = sht.Cells(1, 1).Resize(1, colCount).Value 
         [COLOR=darkgreen]'Set font as bold[/COLOR]
        .Font.Bold = [COLOR=blue]True[/COLOR] 
    [COLOR=blue]End With[/COLOR] 
 
     [COLOR=darkgreen]'We can start loop[/COLOR]
    [COLOR=blue]For Each[/COLOR] sht [COLOR=blue]In[/COLOR] wrk.Worksheets 
         [COLOR=darkgreen]'If worksheet in loop is the last one, stop execution (it is Master worksheet)[/COLOR]
        [COLOR=blue]If[/COLOR] sht.Index = wrk.Worksheets.Count [COLOR=blue]Then[/COLOR] 
            Exit [COLOR=blue]For[/COLOR] 
        [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR] 
         [COLOR=darkgreen]'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets[/COLOR]
        [COLOR=blue]Set[/COLOR] rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount)) 
         [COLOR=darkgreen]'Put data into the Master worksheet[/COLOR]
        trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value 
    [COLOR=blue]Next[/COLOR] sht 
     [COLOR=darkgreen]'Fit the columns in Master worksheet[/COLOR]
    trg.Columns.AutoFit 
 
     [COLOR=darkgreen]'Screen updating should be activated[/COLOR]
    Application.ScreenUpdating = [COLOR=blue]True[/COLOR] 
[COLOR=blue]End Sub[/COLOR]