MacroProblem-How to All Sheets Except One Specific Sheet

cgeorge4

Board Regular
Joined
Jul 24, 2011
Messages
91
Hello, I hope some Darling can assist me.

I have a macro that selects all sheets - no matter how they are named - or how many sheets there are (normally 5 to 10 new sheets).

The problem is that there are sheet names in my macro and I might have one new sheet or two with different names from month-to-month.

Here is my code to select all sheets that I currently have:

Sheets(Array("Account Setups", "ACNOF", "Exceptions", "NEW", "Pay Now", _
"Service Bills", "Term")).Select
Sheets("Term").Activate
End Sub


What I need is a macro that selects ALL sheets (no matter what the sheet names are or how many new sheets there are).

Here are my details:
1) There will always be 1 sheet that is considered the "master" sheet and it is always called "Text Source".

2) The 5 to 10 new sheets will have different names from month to month.

I need a macro that wil select every other sheet EXCEPT the one called "Text Source" - then hide column A for all the sheets selected - then change the font to "8" for all those sheets selected.

I have not been able to make it work.

Thank you in advance for your help.

Juicy,
 

Some videos you may like

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.

shg

MrExcel MVP
Joined
May 7, 2008
Messages
21,782
Office Version
  1. 2010
Platform
  1. Windows
Maybe ...

Code:
Sub x()
    Dim wks         As Worksheet
 
    For Each wks In Worksheets
        If LCase(wks.Name) <> "text source" Then
            wks.Columns("A").Hidden = True
            wks.Cells.Font.Size = 8
        End If
    Next wks
End Sub
 

cgeorge4

Board Regular
Joined
Jul 24, 2011
Messages
91
Thank you so much!.
It worked perfectly.

You are fabulous.....thank you.

Juicy,
 

cgeorge4

Board Regular
Joined
Jul 24, 2011
Messages
91
Please help me.....

I don't know why I'm not getting any response to my posts. I'm not upset - curious. I have 2 new posts (different thread) that have received no reply at all from anyone.:(

This is urgent.......please.

Here is my message again;)

I have a code that creates new sheets based on category names from a 'Master' sheet.

I have had to add 2 new categories to the master. The code does create a sheet for the new category - but it doesn't have a name - and then the code stops - and I receive a pivot table error message.

I was assisted with this code and it does work brilliantly as long as there isn't a new category other than the ones listed below in red. The code fails because of the sheet array named in the code.....I think. In this line of code:
Sheets(Array("Account Setups", "ACNOF", "Exceptions", "Pay Now", "Service Bills", _
"Term")).Select



Please help me to replace to sheet array section of the code (if that is certainly what the problem is).....with a line of code that will work for any old or new categories from the master. I don't know ahead of time what categories there might be. There might be all the ones listed above and also 1 or 2 new ones......so I need the code to be flexible and perhaps not have their names in the code - but to run on any new sheet.

Thank you,

Here is the code I'm using:

Sub CopyToSheetByType_AndPIVOTS11()
Dim lastrow As Long, LastCol As Integer, i As Long, iStart As Long, iEnd As Long
Dim ws As Worksheet
Application.ScreenUpdating = False
With ActiveSheet
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
.Range(.Cells(2, 1), Cells(lastrow, LastCol)).Sort Key1:=Range("a2"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
iStart = 2
For i = 2 To lastrow
If .Range("a" & i).Value <> .Range("a" & i + 1).Value Then
iEnd = i
Sheets.Add after:=Sheets(Sheets.Count)
Set ws = ActiveSheet
On Error Resume Next
ws.name = .Range("a" & iStart).Value
On Error GoTo 0
ws.Range(Cells(1, 1), Cells(1, LastCol)).Value = .Range(.Cells(1, 1), .Cells(1, LastCol)).Value
.Range(.Cells(iStart, 1), .Cells(iEnd, LastCol)).Copy Destination:=ws.Range("A2")
iStart = iEnd + 1
End If
Next i
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
Sheets(Array("Account Setups", "ACNOF", "Exceptions", "Pay Now", "Service Bills", _
"Term")).Select
Sheets("Term").Activate
Cells.Select
With Selection.Font
.name = "Calibri"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Sheets("Term").Select
Range("P1").Select


Dim shtSource As Worksheet
Dim rngSource As Range, rngDest As Range
Dim pvt As PivotTable
On Error GoTo ErrHandler
'this prevents the screen from updating while the macro is running and
'will make the code run faster
Application.ScreenUpdating = False
For Each shtSource In ActiveWorkbook.Worksheets
If shtSource.name <> "Text Source" Then
'Rather than have the pivot table use all rows in column A-N
'just use what has actually been used.
Set rngSource = shtSource.Range("A1").CurrentRegion
'This is where the pivot table will be placed
Set rngDest = shtSource.Range("P4")
'This creates a pivot table. So rather than having to refer to PivotTables("PivotTable14") like before you can just refer to pvt
Set pvt = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngSource, _
Version:=xlPivotTableVersion12).CreatePivotTable(TableDestination:=rngDest, DefaultVersion:=xlPivotTableVersion12)
pvt.AddDataField pvt.PivotFields("Site Code"), "Count of Site Code", xlCount
With pvt.PivotFields("Site Code")
.Orientation = xlRowField
.Position = 1
End With
'Formatting
pvt.TableStyle2 = "PivotStyleDark7"
With shtSource.Cells.Font
.name = "Calibri"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
ActiveWorkbook.ShowPivotTableFieldList = False
End If
Next shtSource
'Turns screen updating back on - this line is critical otherwise
'it will be turned off after the macro has finished.
Application.ScreenUpdating = True
Exit Sub
'Simple error handler in case something goes wrong
ErrHandler:
Application.ScreenUpdating = True
MsgBox "An error occurred: " & Err.Description, vbExclamation, "Error"
End Sub
 

shg

MrExcel MVP
Joined
May 7, 2008
Messages
21,782
Office Version
  1. 2010
Platform
  1. Windows
If this post was solved, as you have indicated, perhaps you should revert to the other post where you asked your other question.
 

cgeorge4

Board Regular
Joined
Jul 24, 2011
Messages
91
I wrote on this one - to you - because you had helped me before.

I'll go write on my other posts then.

thanks,

Juicy
 

Watch MrExcel Video

Forum statistics

Threads
1,123,177
Messages
5,600,160
Members
414,367
Latest member
dw970906

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top