复制、选择性粘贴当前内容并追加到后一个表内

详见附件。

谢谢你，代码很好。不过。与我的想法不同。我要达到的是：
1、数据有效性中不止三项。
2、如果选择跳高，那么复制跳高的表。
3、现在我再选择跳远，那么复制跳远的表。
4、如选择踢毽子，则复制踢毽子。。。。而不是一次性复制。
谢谢。能再替我设计吗？

谢谢你，我知道了
Sub yy()
With Sheets("田赛成绩报告单"): lr = 1        
      lr = .Range("a" & .Cells.Rows.Count).End(3).Row + 2
    .Cells(lr, 1).Resize(15, 9) = [a1:i15].Value
End With
End Sub
另：
End SubSub 取数()
Application.ScreenUpdating = False
Dim sFileName As String, wb As Workbook, f '是否应该为K？
On Error Resume Next
  sFileName = Dir(ThisWorkbook.Path & "\*.*")
  While Not Len(sFileName) = 0
    If sFileName <> ThisWorkbook.Name Then
      Set wb = GetObject(ThisWorkbook.Path & "\" & sFileName)
      k = k + 1: Cells(k, 1) = Split(sFileName, ".")(0)
      Cells(k, 2) = wb.ActiveSheet.[a1]  这个工作簿的活动表的A1赋值给第二列?得不出第2列的也许与这有关？
    wb.Close
    End If
    sFileName = Dir
Wend
Application.ScreenUpdating = True
这是你在帮助他人时写的代码(不打开工作簿取值。我的电脑能得到“英国”、“中国”，却不能得到后面的数字。请教你为什么？)

你的原贴在http://club.excelhome.net/viewth ... p;page=1#pid5103167

Cells(k, 2) = wb.ActiveSheet.[a1:b1]  
因为他上传的是07版本所以没有安装07版的只能取名字

如果全部文件是03版本的应该可以.你可以尝试一下