表间数据调用

ctrdstruaa

高手求助！！！

对话框中将身份证输入后，利用身份证信息作关键字，调用多张表间数据并且一个身份证可能对应多个培训项目，将此身份证所对应所有项目都放在第一张表中

qingc0221

看不出这里的人员信息表有什么用

ctrdstruaa

根据输入身份证号调用人员信息，自动进行填入，有参培项目的人员将参培训信息一并补在人员信息的后面。

ctrdstruaa

根据输入身份证信息，调用人员信息表将信息自动补齐，如里人员有参培信息的，将参培信息添加在人员信息表后，有几次培训就添加几次，为什么代码在执行时，不能显示结果
Sub k1()
    Dim Sh As Worksheet
    Dim key
    Sheet1.Range("A2:Z65536").ClearContents
       key = Val(InputBox("请输入号码：", "提示", "1111"))
    For Each Sh In Worksheets
        If Sh.Name <> Worksheets("导入表").Name Then
         r1 = Sh.Range("a1").CurrentRegion.Rows.Count - 1
         For i = 2 To r1
         If Sh.Cells(i, "a").Value = key Then
         Worksheets("导入表").Range("a65536").End(xlUp).Offset(1, 0) = Sh.Cells(i, "a").Resize(1, 5)
         End If
         Next
     End If
Next
End Sub