Macro to Format Sheet(s) that Contain Specific Text - vba

Question

I currently have a macro that formats an excel file. I was curious if there was a way to have this format all sheets that contain a specific text in the title. I'll have a workbook with numerous tab for various companies with a little different formatting requirements for each company and some months a few companies will be different. If the sheets don't exist, then ignore and move on..... Any help would be greatly appreciated.
Worksheets("DEN BS Assets").Select
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
Cells.Select
Cells.EntireColumn.AutoFit
Columns("A:A").Select
Selection.ColumnWidth = 12
Columns("A:A").Select
Selection.Replace What:="X", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
With ActiveSheet
.Select
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
.DisplayPageBreaks = False
Firstrow = 9
Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
For Lrow = Lastrow To Firstrow Step -1
With .Cells(Lrow, "A")
If Not IsError(.Value) Then
Select Case .Value
Case Is = "Denver", "Inactive", "System:": .EntireRow.Delete
End Select
End If
End With
Next Lrow
End With
With ActiveSheet
.Select
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
.DisplayPageBreaks = False
Firstrow = 7
Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
For Lrow = Lastrow To Firstrow Step -1
With .Cells(Lrow, "A")
If Not IsError(.Value) Then
Select Case .Value
Case Is = "Net Change", "Account:": .EntireRow.Insert
End Select
End If
End With
Next Lrow
End With
With ActiveSheet.Select
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
.DisplayPageBreaks = False
Firstrow = 7
Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
For Lrow = Lastrow To Firstrow Step -1
With .Cells(Lrow, "A")
If Not IsError(.Value) Then
Select Case .Value
Case Is = "Net Change", "Totals:": .EntireRow.Delete
End Select
End If
End With
Next Lrow
End With
Range("A50000").Select
Selection.End(xlUp).Offset(-1, 0).Select
Selection.Insert Shift:=xlToRight
Selection.EntireRow.Insert
Range("A50000").Select
Selection.End(xlUp).Offset(-1, 0).Select
Selection.Insert Shift:=xlToRight
Range("A50000").Select
Selection.End(xlUp).Offset(0, 0).Select
Selection.Insert Shift:=xlToRight
Columns("F").ColumnWidth = 20
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$8"
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With
Rows("9:9").Select
ActiveWindow.FreezePanes = True`

Answer 1

I have made some changes to your code, remove some unnecessary Select statements (although not all as wasn't sure what the end section does). Also don't think you need two loops to insert and then delete rows.
Sub x()
Dim ws As Worksheet
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
For Each ws In Worksheets
If ws.Name Like "Denver*" Then
ws.Cells.EntireColumn.AutoFit
ws.Columns("A:A").ColumnWidth = 12
ws.Columns("A:A").Replace What:="X", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
With ws
.DisplayPageBreaks = False
Firstrow = 9
Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
For Lrow = Lastrow To Firstrow Step -1
With .Cells(Lrow, "A")
If Not IsError(.Value) Then
Select Case .Value
Case Is = "Denver", "Inactive", "System:": .EntireRow.Delete
End Select
End If
End With
Next Lrow
End With
With ws
Firstrow = 7
For Lrow = Lastrow To Firstrow Step -1
With .Cells(Lrow, "A")
If Not IsError(.Value) Then
Select Case .Value
Case Is = "Net Change", "Account:": .EntireRow.Insert
End Select
End If
End With
Next Lrow
End With
With ws
For Lrow = Lastrow To Firstrow Step -1
With .Cells(Lrow, "A")
If Not IsError(.Value) Then
Select Case .Value
Case Is = "Net Change", "Totals:": .EntireRow.Delete
End Select
End If
End With
Next Lrow
End With
ws.Range("A50000").End(xlUp).Offset(-1, 0).Resize(, 2).Insert shift:=xlToRight
ws.Range("A50000").End(xlUp).Offset(-1, 0).EntireRow.Insert
ws.Range("A50000").End(xlUp).Insert shift:=xlToRight
ws.Columns("F").ColumnWidth = 20
With ws.PageSetup
.PrintTitleRows = "$1:$8"
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With
ws.Rows("9:9").Select
ActiveWindow.FreezePanes = True
End If
Next ws
End Sub