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

nnsea

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