Wie wird die Formatierung beibehalten, nachdem VBA-Makro ausgeführt wurde?

Question

Hallo ich habe einen Code aus dem Web, die funktioniert gut nach meiner Anforderung, aber die Formatierung wird gestört, nachdem Makro wie Zeilengrößen ausgeführt, Spaltengrößen sind nicht so, wie es kopiert wird. Am wichtigsten ist, dass das Einfrieren der Spalte in neuen Blättern aufgefrischt wird. Ich hätte gerne die Formatierung so wie sie in den neu erstellten Blättern inklusive Einfrieren ist. Bitte helfen Sie. Code ist wie folgt.

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

Answer 1

Anstatt das neue Blatt zu schaffen unter Verwendung von:

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

halten ein Vorlagenblatt zur Verfügung. Das Vorlagenblatt kann Zeilen und Spalten in der richtigen Größe haben. Es kann auch voreingestellte Header und Formatierungen haben.

Alles, was Sie dann tun müssen, ist kopieren Sie das Vorlagenblatt und füllen Sie es bei Bedarf.

Answer 2

Ihr Code steuert die Größenänderung; Entferne einfach jeden Teil des Codes. d.h.

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

zu

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