Copying cell formats

[DrH100]

[FONT=Arial,Verdana]I've been given a piece of code which was exactly what I was looking for (more accurately what I asked for) and worked brillantly. I have pasted below.

I can quite openly say I don't understand most of it but I would be grateful if someone could provide a small amendment.

In effect the code looks at sheet 'data' and creates new tabs depending on the contents of column f and then pastes data from the entire row into those tabs as appropriate - this is what I asked for and works wonderfully. What I would like it to do is to also copy the format of the row that it is copying. (most importantly the cell borders and colours)

I can (I think) identify the copy and paste elements of the code but have no idea what if anything I can change to make this work.

The code is as follows

Sub  CopyData2()
application.ScreenUpdating = False

Call Sample ' this  inputs data into column f
Dim rCell As Range
Dim lastRow As Long
Dim ws  As Worksheet
lastRow = Sheets("Data").UsedRange.Rows.Count

For Each  rCell In Worksheets("Data").Range("f2:f" &  lastRow).SpecialCells(xlCellTypeConstants)
On Error Resume Next
Set ws =  Worksheets(rCell.Value)
If Err.Number = 9 Then
Set ws =  Worksheets.Add(After:=Sheets(Sheets.Count))
ws.Name = rCell.Value
End  If
On Error GoTo 0
Worksheets("Data").Rows(1).EntireRow.copy  ws.Rows(1)
Worksheets(rCell.Value).Range("a" &  Rows.Count).End(xlUp)(2).EntireRow.Value = _
rCell.EntireRow.Value
Next  rCell
application.ScreenUpdating = True
End Sub

[/FONT][FONT=Arial,Verdana]


Any help as always very much appreciated[/FONT]

 

[AlphaFrog]

[color=green]'Replace this...[/color]
Worksheets(rCell.Value).Range("a" & Rows.Count).End(xlUp)(2).EntireRow.Value = _
rCell.EntireRow.Value
    
[color=green]'With this...[/color]
rCell.EntireRow.Copy _
    Destination:=Worksheets(rCell.Value).Range("a" & Rows.Count).End(xlUp)(2).EntireRow