CODEWITHSUNDEEP
excelvba
Ramu
Ramu

Reputation: 1

how to keep formatting as it is after running vba macro?

Hi i got a code from web, which is working fine according to my requirement, but formatting is being disturbed after running macro like row sizes, column sizes are not as it is copied. Most importantly, column freeze is being unfreezed in new sheets. I would like the formatting as it is in the newly created sheets including freezing panes. Please help. Code is as below.

Sub columntosheets()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim sname As String
Dim sh As Worksheet

Const s As String = "A" 'change to whatever criterion column
Dim d As Object, a, cc&
Dim p&, i&, rws&, cls&


sname = ActiveSheet.Name ' It is mandatory to have the OS sheet as active and then run this code.

Set d = CreateObject("scripting.dictionary")
With Sheets(sname)
    rws = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
    cls = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
    cc = .Columns(s).Column
End With

For Each sh In Worksheets
    d(sh.Name) = 1
Next sh


With Sheets.Add(After:=Sheets(sname))
    Sheets(sname).Cells(1).Resize(rws, cls).Copy .Cells(1)
    .Cells(1).Resize(rws, cls).Sort .Cells(cc), xlDescending, Header:=xlYes
    a = .Cells(cc).Resize(rws + 1, 1)
    p = 3
    For i = 3 To rws + 1
        If a(i, 1) <> a(p, 1) Then
            If d(a(p, 1)) <> 1 Then
                Sheets.Add.Name = a(p, 1)
                .Cells(1).Resize(2, cls).Copy Cells(1)
                .Cells(p, 1).Resize(i - p, cls).Copy Cells(3, 1)
            End If
            p = i
        End If
    Next i
    .Delete
End With
Sheets(sname).Activate

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Upvotes: 0

Views: 1125

Answers (2)

user8285860
user8285860

Reputation:

Your code is directing the resize; just remove each part of code. i.e.

Sheets(sname).Cells(1).Resize(rws, cls).Copy .Cells(1)

to

Sheets(sname).Cells(1).Copy .Cells(1)

Upvotes: 0

Gary&#39;s Student
Gary&#39;s Student

Reputation: 96753

Rather than creating the new sheet using:

With Sheets.Add(After:=Sheets(sname))

keep a template sheet available. The template sheet can have rows and columns correctly sized. It can also have preset headers and formatting.

All you then need to do is copy the template sheet and fill it as necessary.

Upvotes: 1

Related Questions