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

时间:2018-12-10 23:34:49

标签: excel vba excel-vba

希望就我的部分工作代码获得建议,我收到了有关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。部分结果变得更加全面,但仍然缺少数据。

0 个答案:

没有答案