【急急急】关于夸表执行宏命令

我的宏命令在A表里面,然后在A表中把宏命令加到菜单栏的按钮上了,这样打开其他的excel都有这个按钮.(为了防止一次次导入模块的麻烦操作)
我要处理B表的东西,只打开B表,点击按钮,宏命令默认打开A表,
结果直接处理A表了
怎样做才能在B表中使用宏命令能处理B表的内容呢!
上代码

VB code

Sub WebDiv()
'将Researchercomments中的nonthingnew分离出来
Dim i, finalColume As Integer
Dim aRow, aColume As Integer
Dim bRow As Integer

ThisWorkbook.Worksheets(1).Activate
aRow = Range("A1").CurrentRegion.Cells.Rows.Count                               '有效单元格的行数
aColume = Range("A1").CurrentRegion.Cells.Count / aRow                          '有效单元格的列数

'查找表头的"ResearcherComments"项
finalColume = 0
For i = 1 To aColume
    If Trim(ActiveSheet.Cells(1, i)) = "ResearcherComments" Then
        finalColume = i
        ActiveSheet.Name = "Test Sheet1"
        ActiveSheet.Rows("1:1").Select
        ActiveSheet.Rows("1:1").Copy
        If ThisWorkbook.Worksheets.Count < 2 Then
            ThisWorkbook.Worksheets.Add after:=ThisWorkbook.Worksheets(1)
        End If
        ThisWorkbook.Worksheets(2).Activate
        ActiveSheet.Cells(1, 1).Select
        ActiveSheet.Paste
        ActiveSheet.Name = "NoProjects"
        ThisWorkbook.Worksheets(1).Activate
        Exit For
    End If
Next i
If finalColume = 0 Then Exit Sub
'如果查找不到表头的"ResearcherComments"则终止程序
bRow = 1
For i = 2 To aRow
If i > aRow Then Exit For
If Trim(ActiveSheet.Cells(i, finalColume)) = "Nothing New" Then
    ActiveSheet.Rows(Trim(i) & ":" & Trim(i)).Select
    ActiveSheet.Rows(Trim(i) & ":" & Trim(i)).Cut
    ThisWorkbook.Worksheets(2).Activate
    ActiveSheet.Cells(bRow + 1, 1).Select
    ActiveSheet.Paste
    bRow = bRow + 1
    ThisWorkbook.Worksheets(1).Activate
    ActiveSheet.Rows(Trim(i) & ":" & Trim(i)).Select                        '选中原先的空行(剪切并粘贴后变成空行)
    ActiveSheet.Rows(Trim(i) & ":" & Trim(i)).Delete Shift:=xlUp            '删除,并将表格往上提
    aRow = aRow - 1
End If
Next

End Sub

将宏命令不要放在A表里，要放在公共模块里，属性为 Public，即
Public Sub WebDiv()

唉,csdn没人回答,excel home也没人回答,只好自己动脑,喂鸟吃食了.
在B中打开A的宏命令结果操作A表,
那么我在A中打开宏命令并指定B表,就可以了
代码如下
VB code

Sub WebDiv()
'将Researchercomments中的nonthingnew分离出来

Application.ScreenUpdating = False                          '关闭屏幕刷新

Dim i, finalColume As Integer                               'i循环变量,finalcolume记录ResearcherComments的列数
Dim aRow, aColume, bRow As Integer                          'sheet1的行数列数,sheet2的行数
Dim aPath As String                                         '目标路径

''''''''''''''''''''''选择路径''''''''''''''''''''''''''''''
Dim MyDialog As FileDialog
Set MyDialog = Application.FileDialog(msoFileDialogFilePicker) '定义一个打开文件对话框
With MyDialog
.Filters.Add "EXCEL", "*.xls", 1            '筛选excel
.AllowMultiSelect = False                   '如果允许用户选定多个文件或者文件夹，则为TRUE
If .Show = -1 Then                          '如果选择不为空
    aPath = .SelectedItems(1)               '提取第一个选中文件的路径
Else
    Exit Sub                                '如果没有选择文件则退出程序
End If
End With

Dim myBook As Workbook
Dim mySheet As Worksheet

Set myBook = Application.Workbooks.Open(aPath)                                          '打开excel
Set mySheet = myBook.Worksheets(1)
mySheet.Activate                                                                        '激活sheet1
aRow = mySheet.Range("A1").CurrentRegion.Cells.Rows.Count                               '有效单元格的行数
aColume = mySheet.Range("A1").CurrentRegion.Cells.Count / aRow                          '有效单元格的列数

'查找表头的"ResearcherComments"项
finalColume = 0
For i = 1 To aColume
    If Trim(mySheet.Cells(1, i)) = "ResearcherComments" Then
        finalColume = i
        mySheet.Name = "Test Sheet1"                                                    '重命名sheet1
        mySheet.Rows("1:1").Select                                                      '复制表头
        mySheet.Rows("1:1").Copy
        If myBook.Worksheets.Count < 2 Then                                             '判断是否存在sheet2,否则新建
            myBook.Worksheets.Add after:=myBook.Worksheets(1)
        End If
        myBook.Worksheets(2).Activate                                                   '激活sheet2
        myBook.Worksheets(2).Cells(1, 1).Select
        myBook.Worksheets(2).Paste                                                      '粘贴表头
        myBook.Worksheets(2).Name = "NoProjects"                                        '重命名sheet2
        mySheet.Activate                                                                '激活sheet1
        Exit For
    End If
Next i
If finalColume = 0 Then Exit Sub
'如果查找不到表头的"ResearcherComments"则终止程序
bRow = 1
For i = 2 To aRow
If i > aRow Then Exit For                                                              '特殊的结束情况
If Trim(mySheet.Cells(i, finalColume)) = "Nothing New" Then                            '查找Nothing New
    mySheet.Rows(Trim(i) & ":" & Trim(i)).Select
    mySheet.Rows(Trim(i) & ":" & Trim(i)).Cut                                          '剪切行
    myBook.Worksheets(2).Activate                                                      '激活sheet2
    myBook.Worksheets(2).Cells(bRow + 1, 1).Select
    myBook.Worksheets(2).Paste                                                         '粘贴
    bRow = bRow + 1                                                                    '统计sheet2的行数
    mySheet.Activate                                                                   '激活sheet1
    mySheet.Rows(Trim(i) & ":" & Trim(i)).Select                                       '选中原先的空行(剪切并粘贴后变成空行)
    mySheet.Rows(Trim(i) & ":" & Trim(i)).Delete Shift:=xlUp                           '删除,并将表格往上提
    aRow = aRow - 1                                                                    'sheet1行数减1
End If
Next
Application.ScreenUpdating = True                                                      '恢复屏幕刷新
End Sub

楼下散分

公共模块在哪里?..

貌似EXCEL没有公共模块啊,Word有个Normal.dot可以放公共模块,excel怎么放

劫个分……