Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 93
  • Last Modified:

Add sheet names, VBA macro consolidate sheets

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
pdvsa
Asked:
pdvsa
  • 5
  • 3
1 Solution
 
Saqib Husain, SyedEngineerCommented:
This is already listing sheet names in column A of the Combined sheet
0
 
pdvsaProject financeAuthor Commented:
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
 
pdvsaProject financeAuthor Commented:
Not sure if clear...I only want to combine some of the sheets.
0
Independent Software Vendors: 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!

 
Saqib Husain, SyedEngineerCommented:
Yes, All sheets.

How to know "which" sheets?
0
 
pdvsaProject financeAuthor Commented:
They would have certain names.  8 of the sheets out of 20 is the split.
0
 
pdvsaProject financeAuthor Commented:
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
 
Saqib Husain, SyedEngineerCommented:
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
 
pdvsaProject financeAuthor Commented:
that worked perfectly.  Thank you very much the expert assistance.  Have a good day.
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

  • 5
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now