根据3个单独的值复制范围

时间:2012-10-23 06:28:06

标签: excel vba header range row

我有2本工作簿。一个以YYYYW **。xlsx的格式命名,其中*代表周数,一个命名相似但最后有项目控制。第一个工作簿中有许多行包含许多值。它们的范围从300 ---数到800 ---数。这些也有交货日期以及项目是处于活动状态还是已关闭。

项目控制工作簿包含3个工作表,一个用于2012项目,一个用于2013项目,一个用于关闭。

我想问的是如何以编程方式获取数据范围并将它们传输到新工作簿中的相应工作表。

由于

Project|    Description             |   Delivery  |   Total Sales  |  
------------------------------------------------------------------------        
300661 |CCBS - HLP250               |   01/01/2012|  Active        |
------------------------------------------------------------------------      
300710 |STOCK - ITM250 ELECTRICS    |   01/01/2012|  Closed        |
------------------------------------------------------------------------      
300731 |Nirvana: 4th Piece packer   |   28/02/2012|  Closed        | 
------------------------------------------------------------------------     
300766 |STOCK - SATU                |   01/01/2012|  Active        | 
------------------------------------------------------------------------     
300767 |STOCK - HLP 250 CONVERSION  |   01/01/2012|  Active        | 
------------------------------------------------------------------------     
300768 |STOCK - PNEUMATIC, EMBOSSING|   01/01/2012|  Active        | 
------------------------------------------------------------------------     
412972 |I.T.M. BV                   |   23/05/2013|  Closed        |
------------------------------------------------------------------------      
412986 |I.T.M. BV                   |   17/07/2012|  Closed        | 
------------------------------------------------------------------------     
413001 |I.T.M. BV                   |   06/08/2012|  Closed        | 
------------------------------------------------------------------------     
510003 |Internal Project for issuing|   27/12/2013|  Active        | 
------------------------------------------------------------------------    
600161 |Tabak Invest  Kit & Conv    |   28/02/2012|  Closed        | 
------------------------------------------------------------------------     
600166 |UTC DUBAI                   |   10/01/2012|  Closed        | 
------------------------------------------------------------------------     
600168 |UTC HLP250 Conversion       |   20/02/2012|  Closed        | 
------------------------------------------------------------------------  

上述信息需要按交货年份排序,无论是开盘还是关闭,一旦放入正确的纸张,需要将其复制到数字顺序,如图所示。

通过上面的示例项目,由于交付日期和活动状态,510003将进入工作簿2013,而300661,3006,300767和300768将全部进入2012年,剩余的将在项目完成时进入关闭工作表并已关闭状态

1 个答案:

答案 0 :(得分:0)

这应该开始了。你必须做一些调整以匹配你的实际数据和文件,但结构应该是可靠的。

Option Explicit

Sub MoveIt()

Dim wkbData As Workbook, wkbPaste As Workbook

Set wkbData = ThisWorkbook
Set wkbPaste = Workbooks("ProjectControl")

With wkbData

    Dim wks As Worksheet
    Set wks = Sheets(1) 'assumes data is in sheet1

    With wks

        ' -> note that use of .usedrange implies data is in a table with no other _
            data or formatting in the worksheet
        .UsedRange.AutoFilter 4, "Closed"

        Dim rng As Range
        Set rng = Intersect(.UsedRange, .UsedRange.Offset(1)).SpecialCells(xlCellTypeVisible)

        rng.Copy wkbPaste.Sheets("Closed")

        .UsedRange.AutoFilter 4, "Active"
        .UsedRange.AutoFilter 3, xlFilterThisYear

        Set rng = Intersect(.UsedRange, .UsedRange.Offset(1)).SpecialCells(xlCellTypeVisible)

        rng.Copy wkbPaste.Sheets("2012").Range("A1")

        .UsedRange.AutoFilter 4, "Active"
        .UsedRange.AutoFilter 3, xlFilterNextYear

        Set rng = Intersect(.UsedRange, .UsedRange.Offset(1)).SpecialCells(xlCellTypeVisible)

        rng.Copy wkbPaste.Sheets("2013").Range("A1")

    End With

End With

End Sub