|
求老师指点:
按钮后台对应的代码,会按B列供方名称生成各个供方的工作表,我想不让它自己新创建工作表,而是按照“供方统计”这个工作表(里面设置好了格式)来复制并改名,且将检验台账中HCDEFj列的数据,按顺序复制到对应供方工作表下面的第7行开始的ABCDEF列,不知道怎么改,求老师指点一下!谢谢!
如其他几个工作表示例,感谢!
供方统计模板.zip
(160.62 KB, 下载次数: 1)
Sub 拆分1()
Dim wb As Workbook, arr, rng As Range, d As Object, k, t, sh As Worksheet, i&
Set rng = Range("a3:j3")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
arr = Range("b1:b" & Range("b65536").End(xlUp).Row)
Set d = CreateObject("scripting.dictionary")
Set sh = Sheets("供方统计")
For i = 4 To UBound(arr)
' If IsNumeric(arr(i, 1)) Then
If Not d.Exists(arr(i, 1)) Then
Set d(arr(i, 1)) = Cells(i, 1).Resize(1, 10)
Else
Set d(arr(i, 1)) = Union(d(arr(i, 1)), Cells(i, 1).Resize(1, 10))
' End If
End If
Next
k = d.Keys
t = d.Items
With Sheets
For i = 0 To d.Count - 1
With .Add(after:=.Item(.Count))
.Name = k(i)
rng.Copy .Range("A1")
t(i).Copy .Range("A2")
End With
Next
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Sheets("供方统计").Select
MsgBox "完毕"
End Sub
|
|