Excel to copy column headings to new sheet

[mwillerton]

Hi all
I have used some VBA code in an excel spreadsheet 2016.
It looks at a column in a spreadsheet and copies all rows in that sheet where the word in the column matches (Mon) and creates and names a new sheet.
I have then repeated this for each day (Tue, Wed, Thur, Fri etc.)

There are two issues i am having:

1. Copy the column headings to appear in the newly created sheet from the original sheet
2. get the code to pull out all the MON, check a different column for a value (1, 2, 3, 4, 5, 6, reg, reg2) and place those in individual named sheets (MON1, MON2, MONreg etc.)

My code so far is below:
I am not an expert at this VBA

Thanks in advance
Matt


Sub MON()
Const strTest = "Mon"
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim NoRows As Long
Dim DestNoRows As Long
Dim I As Long
Dim rngCells As Range
Dim rngFind As Range

Set wsSource = ActiveSheet

NoRows = wsSource.Range("A65536").End(xlUp).Row
DestNoRows = 2
Set wsDest = ActiveWorkbook.Worksheets.Add
wsDest.Name = "MON"

For I = 1 To NoRows

Set rngCells = wsSource.Range("O" & I & ":F" & I)

If Not (rngCells.Find(strTest) Is Nothing) Then
rngCells.EntireRow.Copy wsDest.Range("A" & DestNoRows)

DestNoRows = DestNoRows + 1
End If
Next I
End Sub

 

[Norie]

For the first part, assuming the headers are in row 1 on the source sheet.

Set wsDest = ActiveWorkbook.Worksheets.Add
wsDest.Name = "MON" 

wsSource.Rows(1).Copy wsDest.Rows(1)

 

[DanteAmor]

You mean in this range of columns: "F:O" the word "MON" may exist, for example if the word "MON" exists in column "F" then create the sheet "MON1". If "MON" exists in column "G" create sheet "MON2" and so on?

 

[Norie]

Matt

Which column do you want to check for 1,2,3 etc.?

 

[mwillerton]

You mean in this range of columns: "F:O" the word "MON" may exist, for example if the word "MON" exists in column "F" then create the sheet "MON1". If "MON" exists in column "G" create sheet "MON2" and so on?

If the word MON exists in column O AND if 1 exists in column F it creates a new sheet called MON1 and copies all rows containing the MON AND the 1.
Then i will just edit it to create another for MON2 and so on

 

[mwillerton]

Matt

Which column do you want to check for 1,2,3 etc.?

column F

 

[mwillerton]

For the first part, assuming the headers are in row 1 on the source sheet.

Set wsDest = ActiveWorkbook.Worksheets.Add
wsDest.Name = "MON"

wsSource.Rows(1).Copy wsDest.Rows(1)

Brilliant, that works. Many thanks.

 

[mwillerton]

Matt

Which column do you want to check for 1,2,3 etc.?

Column F.

What are code tags?

 

[mwillerton]

This is better, sorry didn't read all the rules. Now just the MON1 issue.
Thanks in advance again

Sub MON()
Const strTest = "Mon"
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim NoRows As Long
Dim DestNoRows As Long
Dim I As Long
Dim rngCells As Range
Dim rngFind As Range

Set wsSource = ActiveSheet

NoRows = wsSource.Range("A65536").End(xlUp).Row
DestNoRows = 2
Set wsDest = ActiveWorkbook.Worksheets.Add
wsDest.Name = "MON"
wsSource.Rows(1).Copy wsDest.Rows(1)

For I = 1 To NoRows

Set rngCells = wsSource.Range("O" & I & ":F" & I)

If Not (rngCells.Find(strTest) Is Nothing) Then
rngCells.EntireRow.Copy wsDest.Range("A" & DestNoRows)

DestNoRows = DestNoRows + 1
End If
Next I
End Sub