Macro creates new worksheet (already ready) but i need a little bit of data to be added

Try this code. Put it in a standard module

Option Explicit

Sub copy_rows()
Dim ws As Worksheet
Dim lrow As Long, i As Long
Dim sname As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False

For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Sheet1" Then ws.Delete
Next ws

With Worksheets("Sheet1")
    lrow = .Range("C" & .Rows.Count).End(xlUp).Row
    If lrow = 1 Then Exit Sub
    
    For i = 2 To lrow
        If .Range("C" & i).Interior.ColorIndex <> 43 Then
            sname = .Range("D" & i).Value
            If Not Evaluate("ISREF('" & sname & "'!A1)") Then
                Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = sname
                .Range("C1:G1").Copy Worksheets(sname).Range("A1")
                Worksheets(sname).Range("F1").Value = "Tp-Doc Number"
                Worksheets(sname).Range("G1").Value = "Error Type 8"
                Worksheets(sname).Range("H1").Value = "BA"
            End If
            .Range("C" & i & ":G" & i).Copy Worksheets(sname).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            With Worksheets(sname).Range("A1:H1")
                .Borders.LineStyle = xlContinuous
                .Interior.ColorIndex = 23
                .Columns.AutoFit
                .Font.Bold = True
            End With
            
            .Range("A" & i).Hyperlinks.Add .Range("A" & i), "", "'" & sname & "'!A1", ""
        End If
    Next i
End With

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub