Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2624|回复: 3

[已解决]同一个工作表数据如何按条件自动进入其他工作簿,并实现自动命名,急急急!!

[复制链接]
发表于 2017-3-9 16:26 | 显示全部楼层 |阅读模式


要求:1按客户主管名称排序
2同一个客户主管名称所对应的数据,金额从大到小排序
3将上述按要求整理后的数据,单独生成一个工作薄,文件名命名为客户主管名称
最佳答案
2017-3-17 17:12
思路,
先排序,再按主管筛选,将筛选结果拷贝到新文件,存新文件名为主管名。
筛选下一主管,再拷贝,直到结束。

新建 Microsoft Excel 工作表.rar

8.66 KB, 下载次数: 12

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2017-3-17 17:05 | 显示全部楼层
Public Sub dd()
Dim workrange As Range
Dim name1 As String
Dim rge As Range
Dim wb As Workbook

Set workrange = Intersect(Range("a1").CurrentRegion.Offset(1, 0), Range("a1").CurrentRegion)
    ThisWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ThisWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Intersect(workrange, Columns(1)) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ThisWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Intersect(workrange, Columns(2)) _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ThisWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("a1").CurrentRegion
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
'        .SortMethod = xlPinYin
        .Apply
    End With

For Each rge In Intersect(workrange, Columns(1))
    If rge <> rge.Offset(-1, 0) Then
        ThisWorkbook.Worksheets("Sheet1").Range("a1").CurrentRegion.AutoFilter Field:=1, Criteria1:=rge.Value
        Set wb = Workbooks.Add
        ThisWorkbook.Worksheets("Sheet1").Range("a1").CurrentRegion.Copy Worksheets("Sheet1").Range("a1")
        wb.SaveAs ThisWorkbook.Path & "\" & rge.Value & ".xlsx"
      
    End If
   
Next
      
   
End Sub
回复

使用道具 举报

发表于 2017-3-17 17:12 | 显示全部楼层    本楼为最佳答案   
思路,
先排序,再按主管筛选,将筛选结果拷贝到新文件,存新文件名为主管名。
筛选下一主管,再拷贝,直到结束。
回复

使用道具 举报

 楼主| 发表于 2017-3-28 10:13 | 显示全部楼层
wenzili 发表于 2017-3-17 17:12
思路,
先排序,再按主管筛选,将筛选结果拷贝到新文件,存新文件名为主管名。
筛选下一主管,再拷贝,直 ...

非常感谢您的回复[em23][em23][em23][em23][em23][em23][em23]
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 18:17 , Processed in 0.655868 second(s), 12 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表