mwillerton
New Member
- Joined
- Jul 18, 2011
- Messages
- 15
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
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