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