%求助% 如何按条件把数据导入到另外的工作表中，

ppsnow

问题都写在附件里了，搞不清楚为什么程序老是执行不出我要的结果.

程序如下:

      Sub CommandButton1_Click()
    Dim rcount As Integer
    Dim pd As String
    Dim pdees As String
    Dim cellvalue As Variant
   
    pd = ActiveWorkbook.Name
    pdees = ActiveSheet.Name
   
   
'open the productivity source file
    Workbooks.Open ("S:\EES\40_ORGANIZATION_EES\Productivity\TimeSheet_Cumulation_source.xls")打开数据源
    Windows("TimeSheet_Cumulation_source").Activate
    Sheets("SEP06").Activate ‘激活表A的9月份的表单，因为先做测试，所以先随便写了个月份，但最后是需要把所有月份的数据都提出来的，
   
' Show the hidden rows and columns
    Columns.EntireRow.Hidden = False
    Rows.EntireColumn.Hidden = False
   
'Search for ees in month sheets
    Windows("TimeSheet_Cumulation_source").Activate
    Sheets("SEP06").Activate
    Sheets("SEP06").Range("A3:A64").Select ’要提取的数据在此区域，即部门所在的位置
    For i = 1 To ActiveSheet.UsedRange.Rows.Count ‘提取所在的行，，不知道啊对，
       If ActiveCell.Value = "EES" Then    如果单元格的值为部门EES，那么：
        
        Select Case ActiveCell.Offset(0, 1)  取所在单元格一个的单元格,这里用单步执行,观察的到的值总是为空,为什么呢,???
        
        Case "Chen xue"      ’如果名字为 chen xue
        ActiveCell.Offset(0, 14).Select   那么选取激活单元格所在行的右面第14个单元格 ，
        Selection.Copy   复制
        Windows(pd).Activate 打开b表
        Sheets(pdees).Activate 激活B表中的存放EES的表，
        Range("k4").Select  
        ActiveSheet.Paste   粘贴在“K4”


         CASE……（因为还有好多的员工数据，
        End Select
        
        End If
        Next i
        

End Sub

[此贴子已经被作者于2006-10-28 20:31:13编辑过]

ninar

我是将makro写在sep06.xls中，将数据复制到test.xls中，如果找到相同名字的话。希望能帮得上你。


Sub test()
'
'
'find last i  and last j

Dim last_i%, last_j%
last_i = 4
last_j = 8
Windows("test.xls").Activate
Do While Trim(Cells(last_i + 1, 2).Value) <> ""
    last_i = last_i + 1
Loop

Windows("SEP06.xls").Activate
Do While Trim(Cells(last_j + 1, 2).Value) <> ""
    last_j = last_j + 1
Loop


   
For i = 4 To last_i
    For j = 8 To last_j
     If Workbooks("test.xls").Worksheets(1).Cells(i, 2).Value = _
     Workbooks("SEP06.xls").Worksheets("SEP06").Cells(j, 2).Value Then
    Windows("SEP06.xls").Activate
    Range("N" & j).Select
    Selection.Copy
    Windows("test.xls").Activate
    Range("K" & i).Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Exit For
    End If
    Next j
Next i
End Sub

ppsnow

非常感谢你啊，，，，，