My Goal is to copy the cells A1:AB10 "EXACTLY" as they are. Including
Formatting, cell sizes, and Formulas. I added the ".Formula" because my fist
attempt was coping the value and not the formula, but now if is not coping
the cell sizes and formatting (including conditional formatting). Note that
the target Worksheet will be new so no pre-exiting formatting can be done.
Is this possible?

If Target.Address = "$A$1" Then
Dim NewBettingWS As Worksheet
Set NewBettingWS = Worksheets.Add
With NewBettingWS
.Name = "NewBettingWS"
ActiveSheet.Unprotect
ActiveSheet.Range("A1:AB10").Formula =
Sheets(BettingTemplateSource).Range("A1:AB10").For mula
ActiveSheet.Protect
ActiveWorkbook.Save
End With
End If

CRayF -

Maybe you could use the VBA equivalent of Edit | Move Or Copy Sheets |
Create A Copy, and then delete the rows and columns of the new worksheet
that you don't want to include.

- Mike
www.mikemiddleton.com

"CRayF" wrote in message
...
My Goal is to copy the cells A1:AB10 "EXACTLY" as they are. Including
Formatting, cell sizes, and Formulas. I added the ".Formula" because my
fist
attempt was coping the value and not the formula, but now if is not coping
the cell sizes and formatting (including conditional formatting). Note
that
the target Worksheet will be new so no pre-exiting formatting can be done.
Is this possible?

If Target.Address = "$A$1" Then
Dim NewBettingWS As Worksheet
Set NewBettingWS = Worksheets.Add
With NewBettingWS
.Name = "NewBettingWS"
ActiveSheet.Unprotect
ActiveSheet.Range("A1:AB10").Formula =
Sheets(BettingTemplateSource).Range("A1:AB10").For mula
ActiveSheet.Protect
ActiveWorkbook.Save
End With
End If

I think Mike's suggestion may be the best way to proceded with this as I
don't know of any easy way to copy conditional formatting. Something
like this;

If Target.Address = "$A$1" Then
Dim NewBettingWS As Worksheet
Dim eCol As Integer
Dim eRow As Long

Sheets("BettingTemplateSource").Copy befo=Sheets(1)
Set NewBettingWS = ActiveSheet
With NewBettingWS
.Name = "NewBettingWS"
.Unprotect
eCol = .Cells(1, Columns.Count).End(xlToLeft).Column
eRow = .Cells(Rows.Count, 1).End(xlUp).Row
If eCol 28 Then
.Range(.Cells(1, 29), .Cells(1, eCol)).EntireColumn.Delete
End If
If eRow 10 Then Rows("11:" & eRow).Delete
.Protect
ActiveWorkbook.Save
End With
End If

CRayF wrote:
My Goal is to copy the cells A1:AB10 "EXACTLY" as they are. Including
Formatting, cell sizes, and Formulas. I added the ".Formula" because my fist
attempt was coping the value and not the formula, but now if is not coping
the cell sizes and formatting (including conditional formatting). Note that
the target Worksheet will be new so no pre-exiting formatting can be done.
Is this possible?

If Target.Address = "$A$1" Then
Dim NewBettingWS As Worksheet
Set NewBettingWS = Worksheets.Add
With NewBettingWS
.Name = "NewBettingWS"
ActiveSheet.Unprotect
ActiveSheet.Range("A1:AB10").Formula =
Sheets(BettingTemplateSource).Range("A1:AB10").For mula
ActiveSheet.Protect
ActiveWorkbook.Save
End With
End If

I took out the deletes and it at least copied all the cells with formulas.

I was hoping to trim the template down to just the 22 rows and repeat the
last 12 over and aver again onto the new Worksheet. The first 10 rows are
"like a header" and then the next 12 rows starting in row 11 (rows 11-22)
would be copied to the new worksheet with the header (rows 1-10) and
replicate rows 11-22 again to 23-34, then 35-46, etc...
Is it safe to assume that this can't be done?
At least this is a start...



If Target.Address = "$A$1" Then
Dim NewBettingWS As Worksheet
Dim eCol As Integer
Dim eRow As Long

Sheets(BettingTemplateSource).Copy befo=Sheets(1)
Set NewBettingWS = ActiveSheet
With NewBettingWS
.Name = Format(Sheets(ProgramDataInput). _
Range("F3").Value, "mm-dd-yy ") & _
Left(Sheets(ProgramDataInput).Range("H3").Value, 3)

.Unprotect
eCol = .Cells(1, Columns.Count).End(xlToLeft).Column
eRow = .Cells(Rows.Count, 1).End(xlUp).Row
If eCol 28 Then
.Range(.Cells(1, 29), .Cells(1, eCol)).EntireColumn.Delete
End If
If eRow 10 Then Rows("11:" & eRow).Delete
.Protect
ActiveWorkbook.Save
End With
End If



"Rowan" wrote:

I think Mike's suggestion may be the best way to proceded with this as I
don't know of any easy way to copy conditional formatting. Something
like this;

If Target.Address = "$A$1" Then
Dim NewBettingWS As Worksheet
Dim eCol As Integer
Dim eRow As Long

Sheets("BettingTemplateSource").Copy befo=Sheets(1)
Set NewBettingWS = ActiveSheet
With NewBettingWS
.Name = "NewBettingWS"
.Unprotect
eCol = .Cells(1, Columns.Count).End(xlToLeft).Column
eRow = .Cells(Rows.Count, 1).End(xlUp).Row
If eCol 28 Then
.Range(.Cells(1, 29), .Cells(1, eCol)).EntireColumn.Delete
End If
If eRow 10 Then Rows("11:" & eRow).Delete
.Protect
ActiveWorkbook.Save
End With
End If

CRayF wrote:
My Goal is to copy the cells A1:AB10 "EXACTLY" as they are. Including
Formatting, cell sizes, and Formulas. I added the ".Formula" because my fist
attempt was coping the value and not the formula, but now if is not coping
the cell sizes and formatting (including conditional formatting). Note that
the target Worksheet will be new so no pre-exiting formatting can be done.
Is this possible?

If Target.Address = "$A$1" Then
Dim NewBettingWS As Worksheet
Set NewBettingWS = Worksheets.Add
With NewBettingWS
.Name = "NewBettingWS"
ActiveSheet.Unprotect
ActiveSheet.Range("A1:AB10").Formula =
Sheets(BettingTemplateSource).Range("A1:AB10").For mula
ActiveSheet.Protect
ActiveWorkbook.Save
End With
End If

You don't say how many times you want to repeat the rows but maybe
something like this (repeates 10 times).

If Target.Address = "$A$1" Then
Dim NewBettingWS As Worksheet
Dim i As Integer

Sheets("BettingTemplateSource").Copy befo=ActiveSheet
Set NewBettingWS = ActiveSheet
With NewBettingWS
.Name = "NewBettingWS"
.Unprotect
.Tab.ColorIndex = 3 'or replace with index number
For i = 0 To 9
.Rows("11:22").Copy .Cells((i * 12) + 23, 1)
Next i
.Protect
ActiveWorkbook.Save
End With
End If

Regards
Rowan

CRayF wrote:
I took out the deletes and it at least copied all the cells with formulas.

I was hoping to trim the template down to just the 22 rows and repeat the
last 12 over and aver again onto the new Worksheet. The first 10 rows are
"like a header" and then the next 12 rows starting in row 11 (rows 11-22)
would be copied to the new worksheet with the header (rows 1-10) and
replicate rows 11-22 again to 23-34, then 35-46, etc...
Is it safe to assume that this can't be done?
At least this is a start...



If Target.Address = "$A$1" Then
Dim NewBettingWS As Worksheet
Dim eCol As Integer
Dim eRow As Long

Sheets(BettingTemplateSource).Copy befo=Sheets(1)
Set NewBettingWS = ActiveSheet
With NewBettingWS
.Name = Format(Sheets(ProgramDataInput). _
Range("F3").Value, "mm-dd-yy ") & _
Left(Sheets(ProgramDataInput).Range("H3").Value, 3)

.Unprotect
eCol = .Cells(1, Columns.Count).End(xlToLeft).Column
eRow = .Cells(Rows.Count, 1).End(xlUp).Row
If eCol 28 Then
.Range(.Cells(1, 29), .Cells(1, eCol)).EntireColumn.Delete
End If
If eRow 10 Then Rows("11:" & eRow).Delete
.Protect
ActiveWorkbook.Save
End With
End If



"Rowan" wrote:


I think Mike's suggestion may be the best way to proceded with this as I
don't know of any easy way to copy conditional formatting. Something
like this;

If Target.Address = "$A$1" Then
Dim NewBettingWS As Worksheet
Dim eCol As Integer
Dim eRow As Long

Sheets("BettingTemplateSource").Copy befo=Sheets(1)
Set NewBettingWS = ActiveSheet
With NewBettingWS
.Name = "NewBettingWS"
.Unprotect
eCol = .Cells(1, Columns.Count).End(xlToLeft).Column
eRow = .Cells(Rows.Count, 1).End(xlUp).Row
If eCol 28 Then
.Range(.Cells(1, 29), .Cells(1, eCol)).EntireColumn.Delete
End If
If eRow 10 Then Rows("11:" & eRow).Delete
.Protect
ActiveWorkbook.Save
End With
End If

CRayF wrote:

My Goal is to copy the cells A1:AB10 "EXACTLY" as they are. Including
Formatting, cell sizes, and Formulas. I added the ".Formula" because my fist
attempt was coping the value and not the formula, but now if is not coping
the cell sizes and formatting (including conditional formatting). Note that
the target Worksheet will be new so no pre-exiting formatting can be done.
Is this possible?

If Target.Address = "$A$1" Then
Dim NewBettingWS As Worksheet
Set NewBettingWS = Worksheets.Add
With NewBettingWS
.Name = "NewBettingWS"
ActiveSheet.Unprotect
ActiveSheet.Range("A1:AB10").Formula =
Sheets(BettingTemplateSource).Range("A1:AB10"). Formula
ActiveSheet.Protect
ActiveWorkbook.Save
End With
End If

Nice Job.
You don't say how many times you want to repeat the rows

Can this be done as long as a cell tests empty?

The purpose of this is when the cell on the BettingTemplateSource Worksheet
(Source) is selected this code would create a NEW Race Track Worksheet named
€œmm-dd-yy rrr€� ex. 09-21-05 PHX (Phoenix) from data on the main Worksheet
called ProgramDataInput Worksheet (TXT Imported). And is created on the next
TAB to the left of the Active Woorksheet and give it a color TAB. (Very Nice
Job - Thanks) .

The intent of the BettingTemplateSource Worksheet was I could use it as a
master, and dish out the new Worksheet's for each race using the
BettingTemplateSource Worksheet as its source. Your code you so elegantly
crafted below does exactly that.

The perfect scenario would be for the LOOP to END when one of the matching
cell numbers from the ProgramDataInput worksheet tests empty. So each time
through the LOOP the €œA1€� cell (, A13, A25, A37, A49, etc) is tested for
empty, and if so, then terminate the coping.

How hard would it be in implement testing for a cell value?

This is what I understand:
We want to create a new sheet called NewBettingWs.
Rows 1 to 10 of this sheet will be the same as rows one to ten in the
sheet BettingTemplateSource.
Then we will copy over rows 11 to 22 of the BettingTemplateSource sheet
repeatedly to mirror the number of groups (12 rows per group) on the
ProgramDataInput sheet starting in cell A13.

Maybe like this:

If Target.Address = "$A$1" Then
Dim NewBettingWS As Worksheet
Dim srcSht As Worksheet
Dim i As Integer
Dim j As Integer
Dim src As Variant

Set srcSht = Sheets("ProgramDataInput")

Sheets("BettingTemplateSource").Copy befo=ActiveSheet
Set NewBettingWS = ActiveSheet
With NewBettingWS
.Name = "NewBettingWS"
.Unprotect
.Tab.ColorIndex = 3
src = srcSht.Range("A13").Value
i = 13
j = 0
Do Until src = ""
.Rows("11:22").Copy .Cells((j * 12) + 23, 1)
i = i + 12
j = j + 1
src = srcSht.Cells(i, 1).Value
Loop
.Protect
ActiveWorkbook.Save
End With
End If

Regards
Rowan

CRayF wrote:
Nice Job.

You don't say how many times you want to repeat the rows


Can this be done as long as a cell tests empty?

The purpose of this is when the cell on the BettingTemplateSource Worksheet
(Source) is selected this code would create a NEW Race Track Worksheet named
€œmm-dd-yy rrr€� ex. 09-21-05 PHX (Phoenix) from data on the main Worksheet
called ProgramDataInput Worksheet (TXT Imported). And is created on the next
TAB to the left of the Active Woorksheet and give it a color TAB. (Very Nice
Job - Thanks) .

The intent of the BettingTemplateSource Worksheet was I could use it as a
master, and dish out the new Worksheet's for each race using the
BettingTemplateSource Worksheet as its source. Your code you so elegantly
crafted below does exactly that.

The perfect scenario would be for the LOOP to END when one of the matching
cell numbers from the ProgramDataInput worksheet tests empty. So each time
through the LOOP the €œA1€� cell (, A13, A25, A37, A49, etc) is tested for
empty, and if so, then terminate the coping.

How hard would it be in implement testing for a cell value?