Macro to copy cell width to new sheets (ie copy original sheet format)

**teenyjem** · 08-20-2013, 06:05 AM

I have a big old spreadsheet that i have that is one big old bit of data with lots of cells.
These cells then get split by country and then customer name, then this auto exports into lots of seperate spreadsheets that i can email to the relevant people. This is great, but when it exports, it doesnt keep the cell widths in the new sheet. Is there something i can add to my macro that will keep the format of the cell width in the new sheets it auto creates?

this is my current code:

Sub macro_1()
Dim count, ws1, ws2
Set ws1 = Sheets("Sales")
count = 2
Do Until ws1.Range("K" & count) = ""
    If Not ws1.Range("K" & count) = ws1.Range("K" & count - 1) _
        Or Not ws1.Range("T" & count) = ws1.Range("T" & count - 1) Then
        Set ws2 = Sheets.Add(After:=Sheets(Sheets.count))
        ws2.Name = Left(ws1.Range("T" & count), 15) & " - " & Left(ws1.Range("K" & count), 10)
        ws1.Rows(1).Copy ws2.Rows(1)
    End If
    ws1.Rows(count).Copy ws2.Rows(Range("A" & Rows.count).End(xlUp).Row + 1)
    count = count + 1
Loop
End Sub

Sub Copy_Sheets_As_New_Workbook()
Dim ws As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each ws In ActiveWorkbook.Worksheets
ws.Copy
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & ws.Name
ActiveWorkbook.Close
Next ws
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Sub UnionMacro()
Call macro_1
Call Copy_Sheets_As_New_Workbook
End Sub

Also, if someone knows how to make it so that the sheet doesnt have to be called sales, as it is just a one tab spreadsheet anyway, and it doesnt matter what it is called thereby replacing or removing the