Group sheets and delete columns

[aidan_cov]

Hi.
I was kindly assisted on this board last week regarding a copy macro but that now needs expanding. It currently looks up a master sheet and copies sections to individual sheets for submitting to employees. However a lot of that info is irrelevant and I want to add a piece of code that groups all of the newly created sheets bar the master sheet and deletes a number of columns, adds a new column header and highlights that same column.
The original code is as follows:

Sub SplitBill()

Dim Rng As Range
Dim Dn As Range

'Display Open Dialog
BillExtract = Application.GetOpenFilename("Excel Files (*.xls*)," & _
"*.xls*", 1, "Select Bill To Extract", "Open", False)

'If user Cancels file selection then exit
If TypeName(BillExtract) = "Boolean" Then
Exit Sub
End If

'Open Result File
Workbooks.Open BillExtract

'Separates the BillExtract name from its full path
SourceFile = Dir(BillExtract)

'Activate the file
Sheets("Sheet1").Activate

'Set the Range as A:A
Set Rng = Range(Range("A:A"), Range("A" & Rows.Count).End(xlUp))

'Find 'Handset Total'
firstRow = 1
For Each Dn In Rng

'Find last filled column
lastCol = ActiveSheet.Range("A1").End(xlToRight).Column

'Return > 0 if match found
If InStr(Dn.Value, "Handset Total") > 0 Then
HSRow = Dn.Row

'Selects range down to Handset Total and across to last column
ActiveSheet.Range("A" & firstRow, ActiveSheet.Cells(HSRow, lastCol)).Select
firstRow = HSRow + 1

'Copies and pastes to new sheet in the Original Bill. Renames new sheet from B6 value
Selection.Copy

Windows(SourceFile).Activate
Worksheets.Add
Selection.PasteSpecial
Range("A1").Select

'Removes unwanted character :
NewName = Replace(Range("B6").Value, ":", "")
ActiveSheet.Name = NewName

Sheets("Sheet1").Activate

Range("A1").Select

Sheets("Sheet1").Activate

'Sets first Row of next range
Cells(HSRow + 1, 1).Activate

End If

Next Dn
Range("A1").Select
MsgBox ("Macro Finished")

End Sub

The code I have tried to use to do the additional operation does not work and I do not have the requisite knowledge to correct it. The code I have is as follows:

Dim ws As Worksheet, x, y
For Each ws In Sheets
If (ws.Name <> "Sheet1") Then
With ws
Range("C:C,E:E,G:G,H:H,I:I,J:J,K:K,L:L,M:M,N:N").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("F7").Select
ActiveCell.FormulaR1C1 = "Job No."
Range("F8").Select
Columns("F:F").EntireColumn.AutoFit
Columns("F:F").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Range("A1").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("Sheet1").Activate
Sheets("Sheet1").Select

Any help as to where I am going wrong would be greatly appreciated.

Many thanks in advance

 

[Trevor G]

I have created an array selection of sheets then added a basic content then autofit the column for each sheet, but not the first. If you look at it you could look to adapt it for all your sheets.

Sub Macro3()
'
' Macro to group sheets and add content
' Then AutoFit Column F
'
Sheets(Array("Sheet2", "Sheet4", "Sheet5")).Select
Sheets("Sheet2").Activate
Range("F7").Select
ActiveCell.FormulaR1C1 = "Job No."
ActiveCell.EntireColumn.AutoFit
Range("A1").Select
Sheets("Sheet1").Select

End Sub

 

[aidan_cov]

Hi Trevor,
Many thanks for that but how will this fit, as part of my original macro is to rename each sheet with an employee name from a particular cell reference (B6) and your array I assume means that each sheet will retain its original tab name. This is why I was trying to group all sheets where the name was greater or less than sheet1 (the master sheet). Also I need to not just autofit but I need to delete columns C,E,G,H,I,J,K,L,M and N as the info in these columns will only confuse them! Any ideas?
Many thanks again in advance.