VBA：自动化跨工作簿复制粘贴及排序

    从一个工作簿各个子表中复制数据粘贴到另一个工作簿指定位置中，并对指定列进行排序，这个是我们在日常工作中经常做的，如何减少繁琐的工作步骤，提高效率，一键完成上面的工作。下面介绍通过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，粘贴上面的代码，保存。

回到表格，在开发工具里-插入-表单控件

选中控件点右键可以选择指定的宏名称，同时修改控件名称。

 关注以下公众号可以更方便查看文章哦(*￣︶￣)