You are here:

Excel/Macro for combining multiple sheets in one

Advertisement


Question
Hi Aidan,

Its me again. this time did find a solution but it probably needs a little bit of tweeking.

I am compiling multiple sheets into a one new sheet, the macro however seems to remove the first row from all the sheets; and then pastes it on the new sheet. I want to change that bit, so that it combines the sheets as is, since in my sheets there are no headers to be removed. The macro is below:

Sub CopyFromWorksheets()
   Dim wrk As Workbook 'Workbook object - Always good to work with object variables
   Dim sht As Worksheet 'Object for handling worksheets in loop
   Dim trg As Worksheet 'Master Worksheet
   Dim rng As Range 'Range object
   Dim colCount As Integer 'Column count in tables in the worksheets
    
   Set wrk = ActiveWorkbook 'Working in active workbook
    
   For Each sht In wrk.Worksheets
       If sht.Name = "Master" Then
         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 Sub
       End If
   Next sht
    
    'We don't want screen updating
   Application.ScreenUpdating = False
    
    'Add new worksheet as the last worksheet
   Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count))
    'Rename the new worksheet
   trg.Name = "Master"
    'Get column headers from the first worksheet
    'Column count first
   Set sht = wrk.Worksheets(1)
   colCount = sht.Cells(1, 255).End(xlToLeft).Column
    'Now retrieve headers, no copy&paste needed
   With trg.Cells(1, 1).Resize(1, colCount)
       .Value = sht.Cells(1, 1).Resize(1, colCount).Value
        'Set font as bold
       .Font.Bold = True
   End With
    
    'We can start loop
   For Each sht In wrk.Worksheets
        'If worksheet in loop is the last one, stop execution (it is Master worksheet)
       If sht.Index = wrk.Worksheets.Count Then
         Exit For
       End If
        'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets
       Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount))
        'Put data into the Master worksheet
       trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
   Next sht
    'Fit the columns in Master worksheet
   trg.Columns.AutoFit
    
    'Screen updating should be activated
   Application.ScreenUpdating = True
End Sub

Pls advise what i need to amend. Many thanks.

Yana

Answer
The comments give you (and me) help to find the line - it's this one
'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets
      Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount))

amend it to cells(1,1) at the start
About Excel
This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here

Excel

All Answers


Answers by Expert:


Ask Experts

Volunteer


Aidan Heritage

Expertise

I have provided first hand support since `95 for Microsoft Office majoring in Word and Excel - support for all versions from 2 onwards. I'm based in the UK, so please allow for time differences when asking me questions from other parts of the world!

Experience

My background is in the insurance industry and call centre areas, but have been called upon to provide many varied solutions.

Education/Credentials
I'm educated to UK A level standard, but as I left school some 30 years ago that is rather irrelevent - university of life has provided more of a background!

©2016 About.com. All rights reserved.