Results 1 to 9 of 9

Combining several Worksheets with same headers into one worksheet

Threaded View

  1. #1
    Registered User
    Join Date
    10-13-2010
    Location
    USA
    MS-Off Ver
    Excel 2007
    Posts
    5

    Combining several Worksheets with same headers into one worksheet

    I cannot figure out why my macro will not run so that all my master worksheet shows ALL columns. When it runs I only receive the first column so I am halfway there. Not sure what I need to change so that all the columns 15 columns.

    Here is the macro:
    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
    Thank you in advance for any help. I am not sure what to do
    Last edited by Paul; 10-27-2010 at 11:43 PM. Reason: Added code tags

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1