VBA实现excel数据-拆分到表

 

 

Sub 表拆分()
    
    Dim imaxRow As Integer, ssName As String, sht As Object, n As Integer
    
    imaxRow = Worksheets("数据").Range("A1").End(xlDown).Row '表的最大行
    
    
    For x = 2 To imaxRow
    
        ssName = Worksheets("数据").Range("C" & x).Value ' 获取列值,即表名
    
        On Error Resume Next '以下程序就算出错也继续运行
        
        Set sht = Worksheets(ssName)  '①
        
        If Err.Number <> 0 Then  '判断表名不存在时, 0 代表存在
            '新建表
            Set sht = Worksheets.Add(, Worksheets("数据"))    '疑惑:②, 此时的表明与①表名并不同
            sht.Name = ssName
            '填写表头
            Worksheets(ssName).Range("A1").Resize(1, 8).Value = _
            Worksheets("数据").Range("A1").Resize(1, 8).Value
    
        End If
            '填数据
            n = sht.Range("A" & Rows.Count).End(xlUp).Row + 1  '获取当前worksheets的行数
            Worksheets(ssName).Range("A" & n).Resize(1, 8).Value = _
            Worksheets("数据").Range("A" & x).Resize(1, 8).Value
    
       Next
End Sub

　　

转载于:https://www.cnblogs.com/joewancn/p/9643520.html