[ RESOLU par des foreumeux.Merci ] Transferts des cellules impairs...

Sub Impairs()
Dim P As Range, decal%
Set P = [K2:K19] 'plage à copier, à adapter
decal = 3 'décalage vers la droite, à adapter
With P.Offset(, decal)
  .FormulaR1C1 = "=IF(MOD(RC[" & -decal & "],2),RC[" & -decal & "],"""")"
  .Value = .Value
End With
End Sub

Sub Pairs()
Dim P As Range, decal%
Set P = [K2:K19] 'plage à copier, à adapter
decal = 3 'décalage vers la droite, à adapter
With P.Offset(, decal)
  .FormulaR1C1 = "=IF(NOT(MOD(RC[" & -decal & "],2)),RC[" & -decal & "],"""")"
  .Value = .Value
End With
End Sub

Option Explicit
Sub Impair_transférer()
    Dim i As Long
    With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
    Application.ScreenUpdating = False
    For i = Cells(Rows.Count, "k").End(xlUp).Row To 2 Step -1
        If Range("k" & i) Mod 2 <> 0 Then Range("k" & i).Offset(, 3) = Range("k" & i)
    Next
    Application.ScreenUpdating = True
    With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
End Sub

Sub Impairs()
Dim source As Range, dest As Range, ad$
Set source = [K2:K19] 'plage à copier, à adapter
Set dest = [M5] '1ère cellule de destination
ad = source(1).Address(0, RelativeTo:=dest)
With dest.Resize(source.Rows.Count)
  .Formula = "=IF(MOD(" & ad & ",2)," & ad & ","""")"
  .Value = .Value
End With
End Sub

Sub Pairs()
Dim source As Range, dest As Range, ad$
Set source = [K2:K19] 'plage à copier, à adapter
Set dest = [M5] '1ère cellule de destination
ad = source(1).Address(0, RelativeTo:=dest)
With dest.Resize(source.Rows.Count)
  .Formula = "=IF(NOT(MOD(" & ad & ",2))," & ad & ","""")"
  .Value = .Value
End With
End Sub

Sub Impairs()
Dim source As Range, dest As Range, ad$
Set source = Feuil2.[K2:K19] 'plage à copier, à adapter
Set dest = Feuil3.[A2] '1ère cellule de destination, à adapter
ad = source(1).Address(0, External:=True, RelativeTo:=dest)
With dest.Resize(source.Rows.Count)
  .Formula = "=IF(MOD(" & ad & ",2)," & ad & ","""")"
  .Value = .Value
End With
dest(0) = "Impairs"
Application.Goto dest(0) 'facultatif
End Sub

Sub Pairs()
Dim source As Range, dest As Range, ad$
Set source = Feuil2.[K2:K19] 'plage à copier, à adapter
Set dest = Feuil3.[A2] '1ère cellule de destination, à adapter
ad = source(1).Address(0, External:=True, RelativeTo:=dest)
With dest.Resize(source.Rows.Count)
  .Formula = "=IF(NOT(MOD(" & ad & ",2))," & ad & ","""")"
  .Value = .Value
End With
dest(0) = "Pairs"
Application.Goto dest(0) 'facultatif
End Sub