XL 2016 Modification d'une macro

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim cel As Range, sh1$, sh2$, pdt$, lg1&, lg2&
  With Target
    If .CountLarge > 1 Then Exit Sub
    If .Column <> 2 Then Exit Sub
    lg1 = .Row: If lg1 < 3 Then Exit Sub
    pdt = .Offset(, 1): If pdt = "" Then Exit Sub
    sh2 = .Value
  End With
  With Application
    .ScreenUpdating = 0: .EnableEvents = 0: .Undo
    sh1 = Target: Target = sh2: .EnableEvents = -1
  End With
  If sh1 <> "" And (sh2 = "" Or sh2 <> sh1) Then
    With Worksheets(sh1)
      Set cel = .Columns(1).Find(pdt, , -4163, 1, 1)
      If Not cel Is Nothing Then .Rows(cel.Row).Delete
    End With
  End If
  If sh2 = "" Then
    Application.EnableEvents = 0: Target = Empty
    Application.EnableEvents = -1
  Else
    With Worksheets(sh2)
      lg2 = .Cells(Rows.Count, 1).End(3).Row + 1
      With .Cells(lg2, 1)
        .Value = pdt                  'Produit
        .Offset(, 1) = Cells(lg1, 5)  'Prix d'achat HT
        .Offset(, 2) = Cells(lg1, 7)  'Prix de vente HT
        .Offset(, 3) = Cells(lg1, 12) 'Marge brute
      End With
    End With
  End If
End Sub

Private Sub Worksheet_Activate()
  Dim dlg&, i%: Application.ScreenUpdating = 0
  dlg = Cells(Rows.Count, 1).End(3).Row
  If dlg > 2 Then [A3].Resize(dlg - 2).ClearContents
  For i = 2 To Worksheets.Count
    Cells(i + 1, 1) = Worksheets(i).Name
  Next i
End Sub

    With Worksheets(sh2)
      lg2 = .Cells(Rows.Count, 1).End(3).Row + 1
      If lg2 = 2 Then lg2 = 3
      With .Cells(lg2, 1)

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim cel As Range, sh1$, sh2$, pdt$, lg1&, lg2&
  With Target
    If .CountLarge > 1 Then Exit Sub
    If .Column <> 2 Then Exit Sub
    lg1 = .Row: If lg1 < 3 Then Exit Sub
    pdt = .Offset(, 1): If pdt = "" Then Exit Sub
    sh2 = .Value
  End With
  With Application
    .ScreenUpdating = 0: .EnableEvents = 0: .Undo
    sh1 = Target: Target = sh2: .EnableEvents = -1
  End With
  If sh1 <> "" And (sh2 = "" Or sh2 <> sh1) Then
    With Worksheets(sh1)
      Set cel = .Columns(1).Find(pdt, , -4163, 1, 1)
      If Not cel Is Nothing Then .Rows(cel.Row).Delete
    End With
  End If
  If sh2 = "" Then
    Application.EnableEvents = 0: Target = Empty
    Application.EnableEvents = -1
  Else
    With Worksheets(sh2)
      lg2 = .Cells(Rows.Count, 1).End(3).Row + 1: If lg2 = 2 Then lg2 = 3
      Cells(lg1, 3).Resize(, 11).Copy: .Cells(lg2, 1).PasteSpecial -4163
      Application.CutCopyMode = 0
    End With
  End If
End Sub

Private Sub Worksheet_Activate()
  Dim dlg&, i%: Application.ScreenUpdating = 0
  dlg = Cells(Rows.Count, 1).End(3).Row
  If dlg > 3 Then [A4].Resize(dlg - 3).ClearContents
  For i = 2 To Worksheets.Count
    Cells(i + 2, 1) = Worksheets(i).Name
  Next i
End Sub