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. Частичные результаты становятся более полными, но все еще отсутствуют данные.