Copy and Paste Loop based on Cell value - vba

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 name, creates it. Then it pastes all rows of data that have the corresponding cell value to that sheet. Ie. if a cell contains the following:
column a column b
dc00025 data value
If dc00025 doesn't exist, it'll make the sheet. And paste all rows with dc00025 in A.
This works perfectly. However, I noticed when you run this macro after a sheet has already been created, for some reason it adds thousands of columns dramatically slowing down excel.
To fix this, would it be possible to modify the script to only copy columns b:o rather tahnt he entire row? Pasting them starting at A3 would be preferable but I'm not sure how to fix that.
Thanks in advance.
Sub CopyCodes()
Application.ScreenUpdating = False
Dim rCell As Range
Dim lastrow As Long
lastrow = Sheets("Data").UsedRange.Rows.Count
For Each rCell In Worksheets("Data").Range("A2:A" & lastrow).SpecialCells(xlCellTypeConstants)
If Not SheetExists(rCell.Value) Then
With Worksheets.Add(, Worksheets(Worksheets.Count))
.Name = rCell.Value
End With
End If
Worksheets("Data").Rows(1).EntireRow.Copy Worksheets(rCell.Value).Rows(1)
Worksheets(rCell.Value).Range("A" & Rows.Count).End(xlUp)(2).EntireRow.Value = _
rCell.EntireRow.Value
Next rCell
Application.ScreenUpdating = True
End Sub
Function SheetExists(wsName As String)
On Error Resume Next
SheetExists = Worksheets(wsName).Name = wsName
End Function

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