+ Reply to Thread
Results 1 to 3 of 3

Tell program to omit a certain tab

Hybrid View

  1. #1
    Registered User
    Join Date
    07-28-2010
    Location
    Chambersburg, PA, USA
    MS-Off Ver
    Excel 2010
    Posts
    39

    Question Tell program to omit a certain tab

    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
    A friend of mine made me this code and it basically combines all tabs into 1 "Master" tab. I need to modified it to omit the first tab. Its always named "Delivery Schedule". Can someone help me with this? I'm still a noob when it comes to programing.

  2. #2
    Forum Expert
    Join Date
    11-29-2010
    Location
    Ukraine
    MS-Off Ver
    Excel 2019
    Posts
    4,168

    Re: Tell program to omit a certain tab

    hi, try to change this:
     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
    to this:
    If sht.Name <> "Delivery Schedule" Then
            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
            End If

  3. #3
    Forum Guru MarvinP's Avatar
    Join Date
    07-23-2010
    Location
    Woodinville, WA
    MS-Off Ver
    Office 365
    Posts
    16,169

    Re: Tell program to omit a certain tab

    Hi Oly Steel Man,

    Try this code with a few updates to the original you have.
    Option Explicit
    
    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
         
        'In any of the sheets are named "Master" then don't continue
        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 - Name it Master
        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(2)
        colCount = sht.Cells(1, Columns.Count).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
            If sht.Name = "Delivery Schedule" Then
                GoTo JumpDS
            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
    JumpDS:
        Next sht
         'Fit the columns in Master worksheet
        trg.Columns.AutoFit
         
         'Screen updating should be activated
        Application.ScreenUpdating = True
    End Sub
    One test is worth a thousand opinions.
    Click the * Add Reputation below to say thanks.

+ Reply to Thread

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