VBA提取excel中的一些特定数据 并复制到同个文件的工作表（Sheet）中解决方法

VBA提取excel中的一些特定数据 并复制到同个文件的工作表（Sheet）中
例如 有这样子的excel表格

就是想 做一个按钮
这个按钮的功能是
点击一下，就可以分析FREQUENCY这一列
把属于周一（Mon）的那一行数据的Parameters 数据抽出来，放到别的名字叫Mon的sheet去，当然这些sheet已经存在了
把属于周二（Tue）的那一行数据的Parameters 数据抽出来，放到别的名字叫Tue的sheet去，当然这些sheet已经存在了
・・・・・・・
・・・・・・・


例如;
对于周一（Mon）
应该把Parameters是 1，4，5，6的这一行的数据 抽出来放到Mon的sheet去

对于周周二（Tue）
应该把Parameters是 1-6 的数据 抽出来放到Tue的sheet去



------------------------------------------------------------------------
[b]Parameters        Runtime User              FREQUENCY
------------------------------------------------------------------------
1                           NCSADSM1                   Mon-Sun    
2                           NCSADSM2                   Tue-Sun    
3                           NCSADSM3                   Tue-Sun    
4                           NCSADSM4                   Mon-Sun    
5                           NCSADSM5                   Mon-Sun    
6                           NCSADSM6                   Mon-Fri  
--------------------------------------------------------------------------


在线等啊
谢谢了
OK的话，马上结帖给分！！！

------解决方案--------------------

Sub test()


Dim flag As Boolean

Dim str, cell

'MsgBox Sheets("Mon").[A65535].End(xlUp).Row

For Each cell In Range(Cells(1, 3), Cells(Range("A65535").End(xlUp).Row, 3))

    flag = False

    For Each str In Array("Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun")

        

        If cell.Row <> 1 Then

            If cell.Row <> 1 And Not (cell.Value Like "*-*") Then Exit Sub

            If Split(cell.Value, "-")(0) = str Then flag = True

            

            If flag And StrComp(str, "Mon", vbTextCompare) = 0 Then

                'Mon

                Rows(cell.Row).Copy

                With Sheets("Mon").Cells(Sheets("Mon").[A65535].End(xlUp).Row + 1, 1)

                    .PasteSpecial xlPasteColumnWidths

                    .PasteSpecial xlPasteAll

                End With

            End If

            

            If flag And StrComp(str, "Tue", vbTextCompare) = 0 Then

                'Tue

                Rows(cell.Row).Copy

                With Sheets("Tue").Cells(Sheets("Tue").[A65535].End(xlUp).Row + 1, 1)

                    .PasteSpecial xlPasteColumnWidths