Copping cells EXACTLY from one Worksheet to a new Worksheet?

[Guest]

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

 

[Mike Middleton]

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

 

[Rowan]

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 before:=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

 

[Guest]

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 before:=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]

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 before:=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

 

[Guest]

Nice Job.
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 it’s 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?

 

[Rowan]

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 before:=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

 

[Guest]

hummm I've learned allot from analyzing your code and modified the entire
module using this style so there are many cosmetic changes Also, I noticed it
was more efficient to use the "srcProgramDataInputWs" as the one to test for
the null value . This worksheet is also is a multiple of 12 rows but the Race
“1†is in B3 instead of A12. “i†starts out as “3†then adds 12 to it and
firsts test B15 for null. (B15=2; B27=3; B39=4, etc.)

Now this works Except it copies one too many rows. The last cell to test
FALSE for null is B171 which = 15 and then B183 indeed contains null.

I added a MsgBox to display "src" (see below) and the last popup says 15,
but it appears to continue onto complete the last copy.

Any clues why it copies one too many rows?
I am just getting started with VBA but I know in REXX there are 2 types of
loops that do almost the same thing; Do UNTIL; and DO WHILE where the UNTIL
terminated at the top of the loop and the WHILE terminates on the end of the
loop. Does VBA compare?

Here is the code again with the MANY changes for references but using your
code, now works, just copies one too many sets.
-------------------------------------------
Dim srcProgramDataInputWs As Worksheet
Dim srcProgramSummaryTemplateWs As Worksheet
Dim srcProgramSummaryWs As Worksheet
Dim srcBettingTemplateWs As Worksheet
Dim racePark As Variant
Dim i As Integer
Dim j As Integer
Dim k As Integer

Set srcProgramSummaryTemplateWs = Sheets("@TemplateProgramSummary")
Set srcProgramSummaryWs = Sheets("ProgramSummary")
Set srcBettingTemplateWs = Sheets("@TempleteBetting")
Set srcProgramDataInputWs = Sheets("ProgramDataInput")
racePark = Left(srcProgramDataInputWs.Range("H3").Value, 3)

If Target.Address = "$A$1" Then
Dim NewBettingWS As Worksheet
Dim NewWSTabColor As Variant
Dim src As Variant

If racePark = "PHX" Then NewWSTabColor = 10
If racePark = "WHE" Then NewWSTabColor = 46
If racePark = "WON" Then NewWSTabColor = 41

srcBettingTemplateWs.Copy before:=ActiveSheet
Set NewBettingWS = ActiveSheet
With NewBettingWS
.Name = Format(srcProgramDataInputWs. _
Range("F3").Value, "mm-dd-yy ") & _
Left(srcProgramDataInputWs.Range("H3").Value, 3)
.Unprotect
.Tab.ColorIndex = NewWSTabColor 'or replace with index number

src = srcProgramDataInputWs.Range("B3").Value
i = 3
j = 0
Do Until src = ""
If MsgBox(src, vbYesNo) = vbYes Then
End If
srcBettingTemplateWs.Rows("11:22").Copy .Cells((j * 12) + 23, 1)
i = i + 12
j = j + 1
src = srcProgramDataInputWs.Cells(i, 2).Value
Loop

.Protect
End With
End If
-------------------------------------------

 

[Rowan]

Hi

I have made a few more changes to the macro - mostly cosmetic, but the
key change should address the extra set of rows that is being copied.
The loop is stopping in the right place i.e in your example copying 15
times, however the macro starts with rows 11 to 22 already populated
which is what is giving you the extra set. So I have changed it to make
the first paste back onto itself in row 11:

srcBettingTemplateWs.Rows("11:22").Copy .Cells((j * 12) + 11, 1)

The complete code:
---------------------------------------------------------------------
Dim srcProgramDataInputWs As Worksheet
'Dim srcProgramSummaryTemplateWs As Worksheet
'Dim srcProgramSummaryWs As Worksheet
Dim srcBettingTemplateWs As Worksheet
Dim racePark As Variant
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim NewBettingWS As Worksheet
Dim NewWSTabColor As Integer
Dim src As Variant

'Set srcProgramSummaryTemplateWs = Sheets("@TemplateProgramSummary")
'Set srcProgramSummaryWs = Sheets("ProgramSummary")
Set srcBettingTemplateWs = Sheets("@TempleteBetting")
Set srcProgramDataInputWs = Sheets("ProgramDataInput")
racePark = Left(srcProgramDataInputWs.Range("H3").Value, 3)

If Target.Address = "$A$1" Then

If racePark = "PHX" Then NewWSTabColor = 10
If racePark = "WHE" Then NewWSTabColor = 46
If racePark = "WON" Then NewWSTabColor = 41

srcBettingTemplateWs.Copy before:=ActiveSheet
Set NewBettingWS = ActiveSheet
With NewBettingWS
.Name = Format(srcProgramDataInputWs. _
Range("F3").Value, "mm-dd-yy ") & racePark
.Unprotect
.Tab.ColorIndex = NewWSTabColor

src = srcProgramDataInputWs.Range("B3").Value
i = 3
j = 0
Do Until src = ""
'MsgBox src
srcBettingTemplateWs.Rows("11:22").Copy .Cells((j * 12) + 11, 1)
i = i + 12
j = j + 1
src = srcProgramDataInputWs.Cells(i, 2).Value
Loop

.Protect
End With
End If
-------------------------------------------------------------------------------

By chance I also used to programm in REXX. In VBA there are a number of
different ways you can set up a loop with subtle differences. Some of
them shown here.

------------------------------------------------------------------------
Sub Loops()
Dim i As Integer
Dim j As Integer

'*******************
'Do Until Loop
'*******************
i = 1
Do Until i = 10
i = i + 1
Loop
MsgBox "Do Until Loop " & i

'********************
'Do Loop Until
'********************
i = 1
Do
i = i + 1
Loop Until i = 10
MsgBox "Do Loop Until " & i

'********************
'Do While Loop
'********************
i = 1
Do While i < 11
i = i + 1
Loop
MsgBox "Do While Loop " & i

'***********************
'Do Loop While
'***********************
i = 1
Do
i = i + 1
Loop While i < 11
MsgBox "Do Loop While " & i

'************************
'For Next Loop
'************************
j = 1
For i = 1 To 10
j = j + 1
Next i
MsgBox "For Next Loop " & j
End Sub
-------------------------------------------------------------------------

It depends on your situation which one you would choose.

With regard to debugging a problem like the one above I find one of the
easiest approaches is to resize my VBE screen so that it takes up about
a third of the screen horizontally - so that I can see the Excel
workbook behind. Then use the F8 key to step through the macro one row
at a time. You can then use then hover your mouse over a variable at any
time to see what it's value is or if you have a number of variables you
want to keep track of use the Locals window.

Hope this helps
Regards
Rowan

 

[Guest]

Terrific, I see where you modified the starting row of from 23to 11. That
help me understand how you coded the loop as well. Now I’m into tweak mode. I
actually used this for the first time tonight on the Phoenix Greyhound races.
I would say this has been a fun “first†VBA/Excel project for me but as a
true programmer at heart, I’ve got idea/enhancements already… ;-) thanks
again. (And thanks for the “loop†code reference below. I’ve save that off.
Is there a good course for some books (URL Links) that show these “commandâ€
references? Parms associated with it and examples of it being put to use. Key
variables like Application, Worksheet, Value, Cell, Range, etc… I’d like to
learn this stuff more.

 

[Rowan]

There a a lot of good books on Excel VBA - look on amazon for the author
John Walkenbach or see www.j-walk.com.

Also have a browse through the Excel Visual Basic help in the VBE. It is
actually quite extensive and has the Excel Object Model in a visual
format which includes all the excel objects eg worksheets, ranges etc.
The section titled Visual Basic conceptual topics has details of loops,
using variables, if..then statements ans so on.

Good luck
Rowan