从一个工作簿各个子表中复制数据粘贴到另一个工作簿指定位置中,并对指定列进行排序,这个是我们在日常工作中经常做的,如何减少繁琐的工作步骤,提高效率,一键完成上面的工作。下面介绍通过VBA,如何自动化跨工作簿复制粘贴及排序。
图一
图二
需要将图一工作簿中三个子表含有公式的数据,复制粘贴数值到图二的表1,并对指定列进行降序排序,可以直接点击图二中执行的控件即可完成;以下是VBA脚本的实现。
Sub scopy2()
'
' 复制粘贴及排序
'
'复制粘贴
Application.ScreenUpdating = False '禁止屏幕更新数据
Windows("xxx.xlsx").Activate '图一的表名
Sheets("表一").Select
Range("B5:X19").Select
Selection.Copy '复制
Windows("aaaa.xlsm").Activate '图二的表名
Sheets("1").Select
Range("A6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False '粘贴成数值
Windows("xxx.xlsx").Activate '图一的表名
Sheets("表二").Select '
Range("B5:T19").Select
Application.CutCopyMode = False
Selection.Copy
Windows("aaaa.xlsm").Activate '图二的表名
Sheets("1").Select
Range("Y6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("xxx.xlsx").Activate
Sheets("表三").Select
Range("B6:R20").Select
Application.CutCopyMode = False
Selection.Copy
Windows("aaaa.xlsm").Activate
Sheets("1").Select
Range("AS6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'筛选排序
Windows("aaaa.xlsm").Activate
Sheets("1").Select
Range("A6:w20").Select
Selection.AutoFilter '筛选
ActiveWorkbook.Worksheets("1").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("1").AutoFilter.Sort.SortFields.Add2 Key:=Range( _
"b6:b20"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal '筛选并对指定列进行排序
With ActiveWorkbook.Worksheets("1").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("I10").Select
Selection.AutoFilter
Range("y6:Aq20").Select
Selection.AutoFilter
ActiveWorkbook.Worksheets("1").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("1").AutoFilter.Sort.SortFields.Add2 Key:=Range( _
"Ab6:Ab20"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("1").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("AB9").Select
Selection.AutoFilter
Range("As6:Bi20").Select
Selection.AutoFilter
ActiveWorkbook.Worksheets("1").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("1").AutoFilter.Sort.SortFields.Add2 Key:=Range( _
"At6:At20"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("1").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("AS12").Select
Selection.AutoFilter '去掉筛选
Application.ScreenUpdating = True '解除禁止屏幕更新数据
End Sub
在图二的子表1的表名点右键,点击查看代码,插入模块1,粘贴上面的代码,保存。
回到表格,在开发工具里-插入-表单控件
选中控件点右键可以选择指定的宏名称,同时修改控件名称。
关注以下公众号可以更方便查看文章哦(* ̄︶ ̄)