Copy and Paste Loop based on Cell value

Question

Created a macro below thanks to help from another that works.

Basically, it takes the value of the cell in column A and, if a sheet doesn\'t exist with that cells n

Answer 1

Suggested fix:

Sub CopyCodes()

    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("A2:A" & 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("A" & Rows.Count).End(xlUp).offset(1,0).EntireRow.Value = _
                                                            rCell.EntireRow.Value

    Next rCell
    Application.ScreenUpdating = True

End Sub