Sub 表拆分优化版() '先清空非主表,再拆分,防止拆分后数据重复 Dim imaxRow As Integer, ssName As String, sht As Object, n As Integer, x As Integer Application.DisplayAlerts = False For x = Worksheets.Count To 1 Step -1 If Worksheets(x).Name = "数据" Then Exit For '遇到worksheets("数据")就停止 Worksheets(x).Delete Next Application.DisplayAlerts = True 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