New record from multi sheets to one sheet

[spmatrix]

Hello to the forum.
I have many sheets and I want from some of them when I make an entry (not the whole line but only a specific cell C8, C9, ....) in each of them, to be copied to the main sheet (UserNames) together with the time and the name of the windows user. In addition, when a change is made to a record it counts the changes they made in cell I8 and enters the time of the change and the windows user name again (it can be the same or another).
Up to a point with the usernames I got it.

Here is the code in Workbook:

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim cell As Range
    Dim CheckCell As Range
    
    '© Creaded by Spiros
 If TypeName(Sh) = "Worksheet" Then
  If Sh.Name <> "ΜΕΝΟΥ" And Sh.Name <> "UserNames(A)" And Sh.Name <> "ΤΜΗΜΑΤΑ" And Sh.Name <> "ΑΝΑΦΟΡΑ-Α" And Sh.Name <> "Chart" And Sh.Name <> "ΑΝΑΦΟΡΑ-Β" Then
    If Not Intersect(Target, Range("C:E")) Is Nothing Then
     'ActiveSheet.Unprotect "mypass"
        For Each cell In Intersect(Target, Range("C:E"))
             Columns(6).AutoFit
             Columns(7).AutoFit

        If Cells(cell.Row, "I").Value = 2 Then  'This is for Pupblisher 2
            If cell.Value <> "" Then
                Cells(cell.Row, "F").Value = Now()
                Worksheets("Usernames(A)").Cells(cell.Row, "D").Value = Now()
                Cells(cell.Row, "H").Value = Environ$("UserName")
                Worksheets("Usernames(A)").Cells(cell.Row, "E").Value = Environ$("UserName")
            Else
                Cells(cell.Row, "F").ClearContents
                Worksheets("Usernames(A)").Cells(cell.Row, "D").ClearContents
                Cells(cell.Row, "H").ClearContents
                Worksheets("Usernames(A)").Cells(cell.Row, "E").ClearContents
            End If
        
        ElseIf Cells(cell.Row, "I").Value = 3 Then 'This is for Pupblisher 3
            If cell.Value <> "" Then
                Cells(cell.Row, "F").Value = Now()
                Worksheets("Usernames(A)").Cells(cell.Row, "F").Value = Now()
                Worksheets("Usernames(A)").Cells(cell.Row, "G").Value = Environ$("UserName")
            Else
                Worksheets("Usernames(A)").Cells(cell.Row, "F").ClearContents
                Worksheets("Usernames(A)").Cells(cell.Row, "G").ClearContents
            End If
        
        ElseIf Cells(cell.Row, "I").Value = 4 Then 'This is for Pupblisher 4
            If cell.Value <> "" Then
                Cells(cell.Row, "F").Value = Now()
                Worksheets("Usernames(A)").Cells(cell.Row, "H").Value = Now()
                Worksheets("Usernames(A)").Cells(cell.Row, "I").Value = Environ$("UserName")
            Else
                Worksheets("Usernames(A)").Cells(cell.Row, "H").ClearContents
                Worksheets("Usernames(A)").Cells(cell.Row, "I").ClearContents
            End If
        
        ElseIf Cells(cell.Row, "I").Value = 5 Then 'This is for Pupblisher 5
            If cell.Value <> "" Then
                Cells(cell.Row, "F").Value = Now()
                Worksheets("Usernames(A)").Cells(cell.Row, "J").Value = Now()
                Worksheets("Usernames(A)").Cells(cell.Row, "K").Value = Environ$("UserName")
            Else
                Worksheets("Usernames(A)").Cells(cell.Row, "J").ClearContents
                Worksheets("Usernames(A)").Cells(cell.Row, "K").ClearContents
            End If
        
        ElseIf Cells(cell.Row, "I").Value = 6 Then 'This is for Pupblisher 6
            If cell.Value <> "" Then
                Cells(cell.Row, "F").Value = Now()
                Worksheets("Usernames(A)").Cells(cell.Row, "L").Value = Now()
                Worksheets("Usernames(A)").Cells(cell.Row, "M").Value = Environ$("UserName")
            Else
                Worksheets("Usernames(A)").Cells(cell.Row, "L").ClearContents
                Worksheets("Usernames(A)").Cells(cell.Row, "M").ClearContents
            End If
        
        ElseIf Cells(cell.Row, "I").Value >= 7 Then 'This is for Pupblisher 7
            If cell.Value <> "" Then
                Cells(cell.Row, "F").Value = Now()
                Worksheets("Usernames(A)").Cells(cell.Row, "N").Value = Now()
                Worksheets("Usernames(A)").Cells(cell.Row, "O").Value = Environ$("UserName")
            Else
                Worksheets("Usernames(A)").Cells(cell.Row, "N").ClearContents
                Worksheets("Usernames(A)").Cells(cell.Row, "O").ClearContents
            End If
        
        Else
            If cell.Value <> "" Then 'This is for Pupblisher 1
                Cells(cell.Row, "F").Value = Now()
                Cells(cell.Row, "C").Copy Worksheets("Usernames(A)").Cells(cell.Row, "A")
                Worksheets("Usernames(A)").Cells(cell.Row, "B").Value = Now()
                Cells(cell.Row, "G").Value = Environ$("UserName")
                Worksheets("Usernames(A)").Cells(cell.Row, "C").Value = Environ$("UserName")
            Else
                Cells(cell.Row, "F").ClearContents
                Worksheets("Usernames(A)").Cells(cell.Row, "A").ClearContents
                Worksheets("Usernames(A)").Cells(cell.Row, "B").ClearContents
                Cells(cell.Row, "G").ClearContents
                Worksheets("Usernames(A)").Cells(cell.Row, "C").ClearContents
            End If
        End If
       
       Next cell
     'ActiveSheet.Protect "mypass"
    End If
  End If
  End If
End Sub

and this is the code for each other sheet (except for those ΜΕΝΟΥ" "UserNames" "ΤΜΗΜΑΤΑ" "ΑΝΑΦΟΡΑ-Α" "Chart" "ΑΝΑΦΟΡΑ-Β"):

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Spiros
    Dim xSRg As Range
    Dim xRRg As Range

        Set xSRg = Range("E8:E2000")
        If Not Intersect(xSRg, Target) Is Nothing Then
            'ActiveSheet.Unprotect "mypass"
    
            For Each xcell In Intersect(xSRg, Target)
                 Application.EnableEvents = False
                 On Error Resume Next
            
              If xcell.Value <> "" Then
                 Set xcell = xcell.Range("A1")
                 Set xRRg = xcell.Offset(0, 4)
                 xRRg.Value = xRRg.Value + 1
                
             Else

                 Set xcell = xcell.Range("A1")
                 Set xRRg = xcell.Offset(0, 4)
                 xRRg.Value = xRRg.Value + 1
             
             End If
                
                 Application.EnableEvents = True
            
           Next xcell
             'ActiveSheet.Protect "mypass"
    
         End If
end Sub

Please for your help.