Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

Add sheet names, VBA macro consolidate sheets

Posted on 2016-11-04
8
Medium Priority
?
80 Views
Last Modified: 2016-11-06
Hello,

I need to modify the below code to add sheet names.  I have 8 sheets to copy.  Typing from phone...please use generic sheet names and i can edit later.  

Grateful for your kind assistance.

This is a follow up to this question yesterday:   https://www.experts-exchange.com/questions/28980993/Code-to-combine-sheets.html?anchor=a41873839¬ificationFollowed=178705137#a41873839


Sub combinesheets()
    Dim ws As Worksheet
    Dim tws As Worksheet
    Dim headerdone As Boolean
    Dim sr As Range
    Dim tr As Range
    headerdone = False
    Application.DisplayAlerts = False
        On Error Resume Next
            ActiveWorkbook.Worksheets("Combined").Delete
        On Error GoTo 0
    Application.DisplayAlerts = False
    Set tws = ActiveWorkbook.Worksheets.Add
    tws.Name = "Combined"
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> "Combined" Then
            If Not headerdone Then
                ws.Range("A6:A7").EntireRow.Resize(, tws.Columns.Count - 1).Copy tws.Range("B6")
                tws.Range("B7").Copy tws.Range("A7")
                tws.Range("A7") = "Sheet name"
                headerdone = True
            End If
            Set sr = ws.Range("A8:A" & ws.Range("A8").End(xlDown).Row).Resize(, tws.Columns.Count - 1)
            Set tr = tws.Range("A" & Rows.Count).End(xlUp).Offset(1)
            sr.Copy tr.Offset(, 1)
            tr.Resize(sr.Rows.Count) = ws.Name
        End If
    Next ws
End Sub
0
Comment
Question by:pdvsa
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 3
8 Comments
 
LVL 43

Accepted Solution

by:
Saqib Husain, Syed earned 2000 total points
ID: 41875595
This is already listing sheet names in column A of the Combined sheet
0
 

Author Comment

by:pdvsa
ID: 41875605
Ok.  I have yet to test.  In the file, there are many sheets.  In the initial question, i removed the sheets i didnt need.  

If kot mistaken, In the combined sheet, the code combines ALL sheets?
0
 

Author Comment

by:pdvsa
ID: 41875608
Not sure if clear...I only want to combine some of the sheets.
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 43

Expert Comment

by:Saqib Husain, Syed
ID: 41875609
Yes, All sheets.

How to know "which" sheets?
0
 

Author Comment

by:pdvsa
ID: 41875627
They would have certain names.  8 of the sheets out of 20 is the split.
0
 

Author Comment

by:pdvsa
ID: 41875850
Saqib,

OK I have tested and I can work with the code the way it stands.  I can filter for the sheets I do not need.  It returns the correct answer.

One thing I would like to request a modification:
Paste Values.  Is this possible?  AS of right now, the code is copying the formulas and after copying, the formulas are referencing an incorrect cell.  

Thank you so much for the help.  
Very nice.
0
 
LVL 43

Expert Comment

by:Saqib Husain, Syed
ID: 41875895
This should take of both your requirements.
The 8 sheets may be modified in the case statement
Sub combinesheets()
    Dim ws As Worksheet
    Dim tws As Worksheet
    Dim headerdone As Boolean
    Dim sr As Range
    Dim tr As Range
    headerdone = False
    Application.DisplayAlerts = False
        On Error Resume Next
            ActiveWorkbook.Worksheets("Combined").Delete
        On Error GoTo 0
    Application.DisplayAlerts = False
    Set tws = ActiveWorkbook.Worksheets.Add
    tws.Name = "Combined"
    For Each ws In ActiveWorkbook.Worksheets
        Select Case ws.Name
        Case "SA-Refined Prod", "SCA-Monomer", "SCA - Poly", "ATC-Mono", "ATC-200075", "ATC - Poly", "Middle East - Poly", "Middle East-Mono"
            If Not headerdone Then
                ws.Range("A6:A7").EntireRow.Resize(, tws.Columns.Count - 1).Copy tws.Range("B6")
                tws.Range("B7").Copy tws.Range("A7")
                tws.Range("A7") = "Sheet name"
                headerdone = True
            End If
            Set sr = ws.Range("A8:A" & ws.Range("A8").End(xlDown).Row).Resize(, tws.Columns.Count - 1)
            Set tr = tws.Range("A" & Rows.Count).End(xlUp).Offset(1)
            sr.Copy tr.Offset(, 1)
            tr.Offset(, 1).Resize(sr.Rows.Count, sr.Columns.Count).Value = sr.Value
            tr.Resize(sr.Rows.Count) = ws.Name
        End Select
    Next ws
End Sub

Open in new window

0
 

Author Comment

by:pdvsa
ID: 41875928
that worked perfectly.  Thank you very much the expert assistance.  Have a good day.
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

604 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question