View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.misc
Dave Peterson Dave Peterson is offline
external usenet poster
 
Posts: 35,218
Default Copy all formats and objects

It may be easier to just copy the master sheet as a whole.

Delete the existing sheet (01, 02, ...) and just copy that master sheet. You
may have to tweak the new sheet (remove stuff you don't want, add a bit that you
do), but it may turn out to be easier than doing all that other stuff.

dim NewWks as worksheet
dim iCtr as long

set mstrwks = Worksheets("01")

for ictr = 2 to 33 'skip the master sheet
on error resume next
application.displayalerts = false
worksheets(format(ictr, "00")).delete
application.displayalerts = true
on error goto 0

mstrwks.copy _
after:=sheets(sheets.count)

activesheet.name = format(ictr, "00")

'clean up anything that you don't want here

next ictr

(Uncompiled. Untested. Watch for typos.)


Learning VBA wrote:

Currently I am using this code to copy Text Boxes to a group of worksheets.
What I would like to do is Remove any and all objects and formats including
CF from the sheets first and then Copy Any and all Objects as well as
Formats including CF from the master worksheet (MstrWks) to all the other
sheets in the range.
The objects may be TextBoxes or Command Buttons, The formats would be Cell
width, row height, Cell colors, Number and text formats as well as any
conditional formats.

I received this code from here several months ago and after a few changes
that I made it works perfectly except when I change a textbox I first have
to remove all boxes from all the sheets except the mastersheet.

Sub Copy_All_Text_Boxes()

Dim iCtr As Long
Dim MstrWks As Worksheet
Dim wks As Worksheet
Dim TB As TextBox
Dim NewTB As TextBox
Dim strSH As String

Set MstrWks = Worksheets("01") '-- the worksheet with the correct Formats
and objects.

For iCtr = 1 To 33
Set wks = Nothing
On Error Resume Next
Set wks = Worksheets(Format(iCtr, "00"))
On Error GoTo 0

If wks Is Nothing Then
MsgBox "worksheets: " & Format(iCtr, "00") & " doesn't exist!"
Else
If wks.Name = MstrWks.Name Then
'skip it
Else
For Each TB In MstrWks.TextBoxes
TB.Copy
wks.Paste
Set NewTB = wks.TextBoxes(wks.TextBoxes.Count)
With NewTB
.Top = TB.Top
.Left = TB.Left
'these two probably aren't necessary
.Width = TB.Width
.Height = TB.Height
End With
Next TB
End If
End If
Next iCtr
End Sub


--

Dave Peterson