Sheets("опыт").Range("b3").Copy Sheets("история").Cells(i, 1)

Sheets("история").Cells(i, 1)=Sheets("опыт").Range("b3").Value

Sub uuu()
      Dim i As Long
      Range("f9") = Now 'это я не понял на какой лист нужно
      'по-идее это время добавления записи значит в историю
      With Sheets("История")
          i = .Cells(Rows.Count, 1).End(xlUp).Row + 1
          .Cells(i, 1) = Sheets("Опыт").Cells(3, 2)
          .Cells(i, 2) = Sheets("Опыт").Cells(4, 3)
          .Cells(i, 3) = Sheets("Опыт").Cells(4, 4)
          .Cells(i, 4) = Sheets("Опыт").Cells(8, 3)
          .Cells(i, 5) = Sheets("Опыт").Cells(9, 3)
          .Cells(i, 6) = Sheets("Опыт").Cells(10, 3)
      End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
      
     For Each cell In Target   'проходим по всем измененным ячейкам
        If Not Intersect(cell, Range("O7:O10000")) Is Nothing Then  'если измененная ячейка попадает в диапазон O2:O10000
             With cell.Offset(0, -11)         'вводим в нужную ячейку дату
                .Value = Date
             End With
        End If
     Next cell
End Sub

cell.Offset(0, -11)   

Private Sub Worksheet_Calculate()
Dim target As Range
Dim Cell As Variant

Set target = Range("мой столбец")
For Each Cell In target.Cells
       If Cell.Offset(0, 1).Value = "" Then
           Cell.Offset(, 2) = Format(Now, "hh:nn")
       End If
Next Cell

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
     If Intersect(Target, Range("C:R")) Is Nothing Then Exit Sub
     Cells(Target.Row, "S") = Now
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C:R")) Is Nothing Then Cells(Target.Row, "S") = Now
End Sub

Sub Controll()
     Dim rr As Range
   Application.ScreenUpdating = False
    x = Worksheets("опыт").Range("k2").Value   'прочитали из ячейки
      ThisWorkbook.Worksheets("история").Activate 'переходим на другой лист
    Set rr = Columns(1).Find(What:=x, lookat:=xlWhole)   'определяем ячейку в которой нужное значение
      If rr Is Nothing Then
     MsgBox "нету ничего", vbCritical 'если не нашлось
     Else
      
    i = rr.Offset(0, 1).Value ' запоминаем что было в ячейке сначала
    If i >= 1 Then
         If MsgBox("Уже касили " & i & " раз, уверен что перекрас, а может 2 раза покрасили", vbYesNo, "Контроль выполнения") = vbYes Then
           rr.Offset(0, 1).Value = 1 + i
           i = i + 1
           MsgBox "Подтвержден " & i & " перекрас для " & x & " покраски"
           ElseIf vbNo Then
             End If
             Else
      rr.Offset(0, 1).Value = 1 + i
      MsgBox "Подтверждена " & x & " покраска"
         End If
      
     End If
        ThisWorkbook.Worksheets("опыт").Activate
        Range("k2").Activate
     Application.ScreenUpdating = True
     End Sub
     
     

     

Private Sub Worksheet_Change(ByVal Target As Range)
      If Not Intersect(Target, Range("K2")) Is Nothing Then
          MsgBox "изменяй меня полностью!"
      End If
End Sub

Worksheet_Change()
Worksheet_SelectionChange()