Depending on the version of excel, you can copy|paste special|columnwidths.

You'll use some code like:

Worksheets("Sheet1").Columns.Copy
Worksheets("sheet2").Range("a1").PasteSpecial Paste:=xlPasteColumnWidths

or in xl2k:

Worksheets("Sheet1").Columns.Copy
Worksheets("sheet2").Range("a1").PasteSpecial Paste:=8

In the code I suggested:

If SheetExists(strCell) Then
'just add the entire row
'to the tempsheet in the next available Row
Else
'create a tempsheet with the column formatting from my
'activesheet and the column names and formatting
'from activesheet Row 3
Set TempWks = Worksheets.Add(after:=ActiveSheet)
TempWks.Name = Format$(strCell, "000")
ActWks.Rows(3).Copy _
Destination:=TempWks.Range("a1")
actwks.columns.copy
tempwks.range("a1").pastespecial
paste:=xlPasteColumnWidths
End If

===========

As for the other stuff, I think you'll need a rewrite of your code. Maybe you
can create a list of all the sheetnames that will be created so that you can add
the extra blank row whenever you need to.

But even then, I would think you'd want to use some unique string to use as a
filler (like $$$$$$$ in column A). Then add all your data normally and then
cycle through all the sheets doing an Edit|replace to get rid of those $$$$$$$
in column A.

And if I wanted to delete those sheets later, I wouldn't add them to my
workbook. I'd create a new workbook and then add them there. Then I could
close that workbook without saving when I wanted to get rid of them.

Dim NewWkbk as workbook
set newwkbk = workbooks.add(1) 'single sheet
newwkbk.worksheets(1).name = "deletemelater"
....

Set TempWks _
= newwkbk.Worksheets.Add(after:=newwkbk.worksheets(n ewwkbk.worksheets.count)



Saucer Man wrote:

<<snipped

- The formatting is still not working. The new sheets are created but the
column widths are all default size. My original sheet that I am working
from has custom widths and column formatting that is not being copied to the
new sheets.

- The way it is now, if I encounter a blank line, I am not copying anything.
I have "If strRegion = "" Then GoTo Continue". I would like to actually
create a blank row in every temp sheet that exists at the time this line is
executed. Then the next time it copys a row to the sheets, there will be a
blank row before it. Is this possible?

- When this is completed, how do I delete all these tempsheets that were
created without deleting the production sheets? The names of the tempsheets
will change daily based on the value of column R.

Thanks again for any assistance.

"Dave Peterson" wrote in message
...
I think if you look at Ron's site, you'll find code that does most of what
you
ask.

Copy|paste should take care of formats (and values and formulas):

Option Explicit
Sub Main()

Dim ActWks As Worksheet
Dim TempWks As Worksheet
Dim ActColumn As Range
Dim ActCell As Range
Dim strCell As String
Dim DestCell As Range

Set ActWks = ActiveSheet

With ActWks
Set ActColumn = Nothing
On Error Resume Next
Set ActColumn = Intersect(.UsedRange, .Range("r4:r" & .Rows.Count))
On Error GoTo 0

If ActColumn Is Nothing Then
MsgBox "nothing column R under row 3!"
Exit Sub
End If
End With

For Each ActCell In ActColumn.Cells
strCell = Format(ActCell.Value, "000")
If strCell = "" _
Or strCell = "Region" Then
'do nothing
Else
If SheetExists(strCell) Then
'just add the entire row
'to the tempsheet in the next available Row
Else
'create a tempsheet with the column formatting from my
'activesheet and the column names and formatting
'from activesheet Row 3
Set TempWks = Worksheets.Add(after:=ActiveSheet)
TempWks.Name = Format$(strCell, "000")
ActWks.Rows(3).Copy _
Destination:=TempWks.Range("a1")
End If
With TempWks
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1,
0)
End With
ActCell.EntireRow.Copy _
Destination:=DestCell
End If

Next ActCell
End Sub

Private Function SheetExists(sname) As Boolean
'Returns TRUE if sheet exists in the active workbook
Dim x As Object
On Error Resume Next
Set x = ActiveWorkbook.Sheets(sname)
If Err = 0 Then
SheetExists = True
Else
SheetExists = False
End If
On Error GoTo 0
End Function


This assumes that column A is always used if the the row is used (to
determine
the destcell).

You could use a different column if you had to (say R):

With TempWks
Set DestCell = .Cells(.Rows.Count, "R").End(xlUp).Offset(1,
0)
Set DestCell = destcell.entirerow.cells(1)
End With

--

Dave Peterson