搜索
查看: 2265|回复: 0

将工作表数据按照部门拆分到部门名称所对应的工作表中

[复制链接]

977

主题

1093

帖子

1万

积分

管理员

Rank: 9Rank: 9Rank: 9

积分
15931
发表于 2019-7-1 09:10:05 | 显示全部楼层 |阅读模式

Sub chaifen1()

'实现功能:将数据表中Range("d" & i)单元格对应的行数据拆分到新表Range("d" & i).value名称的表中

    '定义整型数据i,k,j
    Dim i,k,j As Integer
           
    '遍历第二个工作表到最后一个工作表
    For j = 2 To Sheets.Count
   
        '将工作表数据中的抬头拷贝到其他工作表中去
        Sheet1.Range("a1").Resize(1, 6).Copy Sheets(j).Range("a1")
   
        '遍历数据表中第二行到最后一行数据
        For i = 2 To Sheets(1).Range("a65536").End(xlUp).Row
        
            '假如数据表单元格("d" & i)单元格对应的值等于表二的名称
            If Sheet1.Range("d" & i).Value = Sheets(j).Name Then
            
                '计算表二目前状态下已有多少行数据
                k = Sheets(j).Range("a65536").End(xlUp).Row
               
                '将数据表中Range("d" & i)单元格所在整行数据拷贝到数据表中已有行数的下一行
                Sheet1.Range("d" & i).EntireRow.Copy Sheets(j).Range("a" & k + 1)  
            End If
        Next
    Next
End Sub
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

表格智创网

网站简介:表格智创网,是一家以表格设计和技能分享的专业社区,由会计帮帮网投资建设,尽专业,助提高专业技能。

表格智创网欢迎您!

联系我们

  • 工作时间:早上9:00-16:00
  • 客服电话:18668755857
  • 本站网址:www.excelwps.com
  • 淘宝店址:kjbbw.taobao.com

Powered by Discuz! X3.4 © 2001-2013 Comsenz Inc.

快速回复 返回顶部 返回列表