nnsea 发表于 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
页: [1]
查看完整版本: 将工作表数据按照部门拆分到部门名称所对应的工作表中