如何保持运行vbamacros后的格式？

您好，我从网上得到了一个代码，根据我的要求工作正常，但格式化运行macros像行大小后，扰乱，列大小不是因为它被复制。 最重要的是，柱子冻结正在被解冻。 我希望在新创build的工作表（包括冷冻窗格）中进行格式化。 请帮忙。 代码如下。

子列表（）

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 

结束小组

Answer 1

而不是使用以下方式创build新工作表：

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

保持模板表可用。 模板工作表可以具有正确大小的行和列。 它也可以有预设的标题和格式。

所有你需要做的是复制模板表并填写必要的。

Answer 2

您的代码正在指导resize; 只删除代码的每一部分。 即

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

至

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