自动匹配一年，然后剪切和粘贴

Question

有没有办法自动检查单元格（在这种情况下是一年，即2008年到2013年），当匹配时执行剪切和粘贴，基本上对一系列单元格中的数据进行排序（右侧）列中的一年？在同一行中。

修改

好的团队我似乎已经弄清楚如何手动完成，看到代码的缩写部分

If ActiveCell = 2013 Then
ActiveCell.Offset(, 2).Range("A1:E1").Select
Selection.Cut
ActiveWindow.SmallScroll ToRight:=24
ActiveCell.Offset(0, 24).Range("A1").Select
ActiveSheet.Paste
End If

If ActiveCell = 2012 Then
ActiveCell.Offset(, 2).Range("A1:E1").Select
Selection.Cut
ActiveWindow.SmallScroll ToRight:=18
ActiveCell.Offset(0, 18).Range("A1").Select
ActiveSheet.Paste
End If

现在如何自动化？

第二次编辑......

好的团队我已经用以下代码解决了这个问题，感谢这里的人指出我正确的方向....很棒的工作......

Option Explicit

Sub NoTears()

Dim c As Range
Dim lastrow As Long

lastrow = Range("F" & Rows.Count).End(xlUp).Row

For Each c In Range("F1:C" & lastrow)

 Select Case c.Value

 'Case Is = 2009
 '   c.Offset(0, 2).Resize(1, 5).Cut Cells(Rows.Count, "??") _
       .End(xlUp).Offset(1)

Case Is = 2010
    c.Offset(, 2).Range("A1:E1").Select
    Selection.Cut
    ActiveWindow.SmallScroll ToRight:=8
    c.Offset(0, 8).Range("A1").Select
    ActiveSheet.Paste

Case Is = 2011
    c.Offset(, 2).Range("A1:E1").Select
    Selection.Cut
    ActiveWindow.SmallScroll ToRight:=14
    c.Offset(0, 14).Range("A1").Select
    ActiveSheet.Paste

Case Is = 2012
    c.Offset(, 2).Range("A1:E1").Select
    Selection.Cut
    ActiveWindow.SmallScroll ToRight:=20
    c.Offset(0, 20).Range("A1").Select
    ActiveSheet.Paste

Case Is = 2013
    c.Offset(, 2).Range("A1:E1").Select
    Selection.Cut
    ActiveWindow.SmallScroll ToRight:=26
    c.Offset(0, 26).Range("A1").Select
    ActiveSheet.Paste

  End Select
Next
End Sub

Answer 1

我会做这样的事情：

未经测试

Dim Cell As Range
Dim lastRow as Long

lastRow = Range("F:F").Find("*", Range("F4"), searchdirection:=xlPrevious).Row 'this finds the last row in column F that contains data

For Each Cell In Range("F4:F" & lastrow) 'Loop through the whole table
    Select Case Cell
        Case 2008 'If the cell contains 2008 then...
            lastRow = Range("AD:AD").Find("*", Range("AD4"),searchdirection:=xlPrevious).Row 'Find the last used row in your new table
            Range(Cells(Cell.Row,8),Cells(Cell.Row,12).Copy Cells(lastRow + 1,30) 'Copy/paste the data into your new table
        Case 2009
            'Same concept as before
    End Select
Next Cell

未经测试

您需要根据自己的需要进行修改。具体来说，您需要更新列和偏移数字以正确匹配您的数据和表格（我尽力猜测但我可能会关闭）。