论坛中找到拆分工作表的代码，保留了原表的格式。求助同时保留多列公式

sh0220

求助论坛上各位大神：之前在论坛上找到一段VBA代码，可以按照某列关键字进行拆分单元格，拆分后可保留原有的格式。表格“N、P、R、T、U、W、X ”7列有公式，请大虾帮忙看看如何同时保留表格“N、P、R、T、U、W、X ”7列公式。 感谢！

1. Sub Macro1()
   
2.     Dim arr, brr, d As Object, k, t, a, i&, j&, m&, l&, sh As Worksheet
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     arr = [a1].CurrentRegion
   
7.     For i = 2 To UBound(arr)
   
8.         d(arr(i, 5)) = d(arr(i, 5)) & "," & i
   
9.     Next
   
10.     k = d.Keys
    
11.     t = d.items
    
12.     brr = arr
    
13.     Set sh = ActiveSheet
    
14.     For i = 0 To d.Count - 1
    
15.         m = 1
    
16.         a = Split(t(i), ",")
    
17.         For j = 1 To UBound(a)
    
18.             m = m + 1
    
19.             For l = 1 To UBound(arr, 2)
    
20.                 brr(m, l) = arr(a(j), l)
    
21.             Next
    
22.         Next
    
23.         sh.Copy
    
24.         With ActiveWorkbook
    
25.             .Sheets(1).UsedRange.Offset(m).Clear
    
26.             .Sheets(1).[a1].Resize(m, UBound(arr, 2)) = brr
    
27.             .SaveAs ThisWorkbook.Path & "" & k(i) & ".xls"
    
28.             .Close
    
29.         End With
    
30.     Next
    
31.     Application.DisplayAlerts = True
    
32.     Application.ScreenUpdating = True
    
33. End Sub
    
34. 
    
35. 
    

复制代码

sh0220

朱荣兴 发表于 2018-3-6 22:39
准确的说，这段代码拆分后是不能保留原格式的。可到我的主题里下载    灵活拆分工具。

感谢版主回复，格式可以进一步调整，主要是7列的公式能保留下来就完美了。

sh0220

朱荣兴 发表于 2018-3-6 22:46
呵呵，真正保留原格式就可以保留公式了呀。

顺便请教下，如果在这个代码原型的基础上去保留以上几列的公式，那么在下面那个循环里面需要如何修改呢？非常感谢解答

abc123281

可以保留原格式    采用复制方法

sh0220

abc123281 发表于 2018-3-6 23:06
可以保留原格式    采用复制方法

小白想请教一下需要怎么修改呢？谢谢。

sh0220

朱荣兴 发表于 2018-3-7 08:28

小弟在这里谢谢管理员大神解答！另再请教2个问题：如果把标题行的格式也保留下来以及“I”列以后的格式一起保留下来，并且每个代理商放在一个对应的代理商的工作簿里这个代码还需要怎么修改一下呢？