Question

VBA将符合条件的数据根据等级分类保存到另一个Excel内相应的工作表

PS:1、点击录入数据将图中黄色区域中的值保存到另一个Excel(如同一文件夹下的book2.xls文件）
2、保存时根据黄色区域中的A级、B级、C级、D级分别存入book2.xls中的a工作表、b工作表、c工作表和d工作表
3、注意book2中的格式
百度的不能上传附件，详细可以见http://club.excelhome.net/forum.php?mod=viewthread&tid=1101975&extra=和http://www.exceltip.net/thread-53438-1-1.html都有相应的附件，谢谢了

Answer 1

1 下载附件，点击按钮

2 代码根据A列中A,B,C,D.....在新创建的工作簿中分别建立新工作表饼把A,B,C,D对应的数据全部导入对应的工作表，再把工作簿命名为“新工作簿”且保存在同路径文件夹内

3 不明白hi我，又是点击才能看到图片

Answer 2

'代码比较简单，没有对任何不规范的情况进行容错处理。
Sub Handle_Data()
Dim wb As Workbook
Dim rng As Range
Dim cls As String

Set wb = Nothing
For Each wb In Workbooks '遍历当前所有打开的工作薄文件
    If wb.Name = "book2.xls" Then Exit For '若已有book2则退出循环
Next wb

If wb Is Nothing Then '若book2未打开，则打开当前文件夹下的book2文件
    Set wb = Workbooks.Open(ThisWorkbook.Path & "\book2.xls")
End If

ThisWorkbook.Activate '返回当前工作薄

'遍历每行数据
For Each rng In Range(Worksheets("Sheet1").Range("A2"), Worksheets("Sheet1").Range("A1").End(xlDown))
    rng.Resize(1, 5).Select '显示当前处理的数据行，仅作进度显示用，可以删除
    cls = Replace(rng.Offset(0, 3), "级", "") '取得等级
    
    '根据等级，将当前数据行复制到book2的相应工作表中
    rng.Resize(1, 5).Copy Destination:=wb.Worksheets(cls).Range("B65536").End(xlUp).Offset(1, 0)
Next rng

End Sub

 

追问

后来问稻草人了，在他的那个基础上修改了一些，也是满足需求了，百度只能采纳一个，多谢您的了，我只能给您点赞了，抱歉啊

Answer 3

简单改了一下,详细件附件

追问

看了下您的，您的也是满足要求的，不过那个时候稻草人的回答是最快的，我就先采纳他的了，只能给您追问和点赞了啊，抱歉

Answer 4

图呢？ ？？？

追问

没有截图，截图可能说不清楚，那里面有二个连接，你可以看下那里面，要不你给我一个邮箱，我发给你也可以的

追答

发我邮箱吧

追问

。。。大哥您邮箱呢？？还是匿名回答？

追答

已邮件发给你