基于单元格值的CopyPaste运行时错误？

Question

希望就我的部分工作代码获得建议，我收到了有关VBA代码的好建议，这些代码可以基于单元格值（H）复制行并将其粘贴到以单元格值命名的新工作表中。

但是，我正在使用的代码给出了运行时错误，并且在Excel停止响应/重新启动后，似乎代码只运行了一半的数据。任何建议都值得赞赏。

Sub CopyCodeshort()

    Application.ScreenUpdating = False
    Dim rCell As Range
    Dim lastrow As Long
    Dim shtData As Worksheet, shtDest As Worksheet
    Dim sheetName As String

    Set shtData = Worksheets("Data")

    lastrow = shtData.Cells(Rows.Count, 1).End(xlUp).Row
    For Each rCell In shtData.Range("H2:H" & lastrow).SpecialCells(xlCellTypeConstants)

        sheetName = rCell.Value
        If Not SheetExists(sheetName) Then
            Set shtDest = Worksheets.Add(, Worksheets(Worksheets.Count))
            shtDest.Name = sheetName
            shtData.Rows(1).EntireRow.Copy shtDest.Rows(1)
        Else
            Set shtDest = Worksheets(sheetName)
        End If

        shtDest.Range("H" & Rows.Count).End(xlUp).Offset(1, 0).EntireRow.Value = _
                                                            rCell.EntireRow.Value

    Next rCell
    Application.ScreenUpdating = True

End Sub

编辑： 在听取了您的出色建议后，我做了一些细微调整，现在Excel不再崩溃，但是仍然出现错误，指出我没有足够的内存，然后出现运行时错误1004。部分结果变得更加全面，但仍然缺少数据。