Bug pour supprimer une sélection en retirant la première ligne - VBA

Bonjour,

Lorsque je lance ma macro, elle s'arrete à cette ligne :

Selection.Delete Shift:=xlUp

Sans que je ne sache réellement pourquoi, car je suis passé par l'enregistrement Macro, et cela avait bien fonctionné.

Le but etant de tout supprimer sauf la première ligne.

Aurriez-vous une idée svp ?

Merci à vous.

Bonjour

Si tu envoies le code complet tu auras plus de chance d'avoir une solution

Crdlt

Merci pour le conseil. Je vous joint le code complet du coup.

Sub Lancerunerecherche()
'
' Rechercher Macro

Application.ScreenUpdating = False
Application.PrintCommunication = False

Sheets("BI_Milestones_SAM").Select
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "RFS"
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "MPS"
Sheets("BI_Milestones_SAM").Select
ActiveSheet.Rows("1:1").EntireRow.Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$M$18176").AutoFilter Field:=6, Criteria1:="RFS"
ActiveCell.Cells.Select
Selection.Copy
Sheets("RFS").Select
ActiveCell.Cells.Select
ActiveSheet.Paste
ActiveCell.Offset(0, 6).Columns("A:A").EntireColumn.Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Select
ActiveCell.FormulaR1C1 = "=TODAY()"
ActiveCell.Columns("A:A").EntireColumn.Select
Selection.Delete Shift:=xlToLeft
ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Select
ActiveCell.FormulaR1C1 = "=TODAY()"
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "=AND(RC[-1]>R1C8)"
ActiveCell.Select
Selection.AutoFill Destination:=ActiveCell.Range("A1:A403")
ActiveCell.Range("A1:A403").Select
ActiveCell.Offset(-1, 0).Rows("1:1").EntireRow.Select
Selection.AutoFilter
ActiveCell.Offset(0, 7).Columns("A:A").EntireColumn.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Range("$A$1:$O$404").AutoFilter Field:=8, Criteria1:="FAUX"
ActiveCell.Offset(1, 0).Rows("1:1048575").EntireRow.Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
ActiveCell.Offset(-1, 0).Rows("1:1").EntireRow.Select
Selection.AutoFilter
Selection.AutoFilter
ActiveCell.Offset(2, 7).Range("A1").Select
Sheets("BI_Milestones_SAM").Select
ActiveSheet.Range("$A$1:$M$18176").AutoFilter Field:=6, Criteria1:= _
"Machine Start Production"
ActiveCell.Cells.Select
Selection.Copy
Sheets("MPS").Select
ActiveCell.Cells.Select
ActiveSheet.Paste
Sheets("BI_Milestones_SAM").Select
ActiveCell.Rows("1:1").EntireRow.Select
Application.CutCopyMode = False
Selection.AutoFilter
Selection.AutoFilter
Sheets("MPS").Select
ActiveCell.Offset(0, 7).Columns("A:A").EntireColumn.Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Select
ActiveCell.Formula2R1C1 = "=aujou"
ActiveCell.Select
ActiveCell.FormulaR1C1 = "=TODAY()"
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "=AND(RC[-1]<R1C8)"
ActiveCell.Select
Selection.AutoFill Destination:=ActiveCell.Range("A1:A472")
ActiveCell.Range("A1:A472").Select
ActiveCell.Offset(-1, 0).Rows("1:1").EntireRow.Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$N$473").AutoFilter Field:=8, Criteria1:="FAUX"
ActiveCell.Offset(1, 0).Rows("1:1048575").EntireRow.Select
Selection.Delete Shift:=xlUp
ActiveSheet.Rows("1:1").EntireRow.Select
Selection.AutoFilter
Selection.AutoFilter
ActiveCell.Offset(0, 7).Columns("A:A").EntireColumn.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, -7).Range("A1").Select
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
ActiveCell.Range("A1:N467").AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=Sheets("RFS").Range("A1:B75"), Unique:=False
ActiveWindow.ScrollRow = 366
ActiveWindow.ScrollRow = 365
ActiveWindow.ScrollRow = 363
ActiveWindow.ScrollRow = 362
ActiveWindow.ScrollRow = 349
ActiveWindow.ScrollRow = 345
ActiveWindow.ScrollRow = 341
ActiveWindow.ScrollRow = 339
ActiveWindow.ScrollRow = 336
ActiveWindow.ScrollRow = 334
ActiveWindow.ScrollRow = 328
ActiveWindow.ScrollRow = 327
ActiveWindow.ScrollRow = 326
ActiveWindow.ScrollRow = 325
ActiveWindow.ScrollRow = 323
ActiveWindow.ScrollRow = 322
ActiveWindow.ScrollRow = 321
ActiveWindow.ScrollRow = 320
ActiveWindow.ScrollRow = 319
ActiveWindow.ScrollRow = 318
ActiveWindow.ScrollRow = 317
ActiveWindow.ScrollRow = 316
ActiveWindow.ScrollRow = 315
ActiveWindow.ScrollRow = 314
ActiveWindow.ScrollRow = 313
ActiveWindow.ScrollRow = 312
ActiveWindow.ScrollRow = 311
ActiveWindow.ScrollRow = 310
ActiveWindow.ScrollRow = 307
ActiveWindow.ScrollRow = 306
ActiveWindow.ScrollRow = 304
ActiveWindow.ScrollRow = 303
ActiveWindow.ScrollRow = 302
ActiveWindow.ScrollRow = 301
ActiveWindow.ScrollRow = 298
ActiveWindow.ScrollRow = 295
ActiveWindow.ScrollRow = 288
ActiveWindow.ScrollRow = 256
ActiveWindow.ScrollRow = 1
ActiveCell.Select
Sheets("RFS").Select
ActiveCell.Offset(-2, -7).Range("A1").Select
ActiveCell.FormulaR1C1 = "PROJECT"

Application.ScreenUpdating = True
Application.PrintCommunication = True

End Sub

Edit Modo : mis code entre balises. Pensez à utiliser les balises en cliquant sur l'icone </>