Bonjour curulis57,
Oui c'est vrai qu'en joignant le fichier ce sera plus simple tu as raison, donc en pièce-jointe le fichier que j'ai appelé test.
D'accord je comprend mieux pourquoi cela étire le même chiffre que celui de la cellule A2, merci de ta précision sur ce point.
Voici donc le code entier de ma macro (ce qui est en rouge c'est la où cela me pose un problème):
Option Explicit
Dim derln&, dercol&, dercol2&, j&, f As Worksheet, fr As Worksheet
Sub Retardproduit13h()
Set f = ActiveSheet
'Range("A:B").Delete shift:=xlToLeft
Application.DisplayAlerts = False
Application.ScreenUpdating = False
dercol = Cells(1, Columns.Count).End(xlToLeft).Column
derln = Range("A" & Rows.Count).End(xlUp).Row
Sheets.Add After:=ActiveSheet
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "13h"
Set fr = ActiveSheet
f.Cells.Copy fr.Range("A1")
fr.Range("A:B").Delete shift:=xlToLeft
For j = dercol To 8 Step -1
If fr.Cells(1, j).Value * 24 <> 13 Then
fr.Columns(j).Delete
End If
Next j
If Range("H1") <> "" Then
Range("C2").FormulaR1C1 = "=RC[5]"
Call Extract
Else
fr.Delete
End If
End Sub
Sub Extract()
Range("C1") = "Manquant"
Range("C2:C" & derln).FillDown
Range("C2").Select
Columns("D:G").Delete shift:=xlToLeft
dercol2 = Cells(1, Columns.Count).End(xlToLeft).Column
With Range(Cells(2, 1), Cells(derln, dercol2))
.Sort key1:=Range("C2"), order1:=xlAscending, Header:=xlNo
.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="=1", Formula2:="=40000"
.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Range(Cells(2, 1), Cells(derln, dercol2)).FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
End With
Range("C1").Select
Do While Range("C2") = 0
Range("C2").EntireRow.Delete shift:=xlUp
Loop
'
iRow = Range("A" & Rows.Count).End(xlUp).Row
For x = 2 To iRow
Cells(x, 1) = Left(Cells(x, 1), 12)
Next
'
Range("F2").Select
ActiveCell.FormulaR1C1 = "PC"
With ActiveCell.Characters(Start:=1, Length:=2).Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("F3").Select
ActiveCell.FormulaR1C1 = "Traiteur"
With ActiveCell.Characters(Start:=1, Length:=8).Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("F4").Select
ActiveCell.FormulaR1C1 = "SDW"
With ActiveCell.Characters(Start:=1, Length:=3).Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("G2").Select
ActiveCell.FormulaR1C1 = "=SUM(R2C3:R400C3)-R[1]C-R[2]C"
Range("G3").Select
ActiveCell.FormulaR1C1 = _
"=SUMIFS(R2C3:R400C3,R2C1:R400C1,""<=14000"",R2C1:R400C1,"">=13000"")"
Range("G4").Select
ActiveCell.FormulaR1C1 = _
"=SUMIFS(R2C3:R400C3,R2C1:R400C1,""<=33000"",R2C1:R400C1,"">=30100"")"
End Sub