Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear

SAAD doli · 28 Mars 2023

Bonjour j'essaie d'optimiser un projet vba
J'ai commencé par réduire les selects
un erreur parait toujours je sais pas pourquoi
merci si vous pouvez me proposer des optimisations du code
Sub Macro1()
'
' Macro1 Macro
'
' Sub Miseàjour()
'
' Miseàjour Macro
'

' Suppression Filtre
Sheets("FS_semaine N").Select
Rows("1:1").Select
Selection.AutoFilter

' Arrangement onglet vierge (ordre croissant et colonnes rangées)
Sheets("vierge").Select
Cells.Select
' Selection.Columns.Ungroup
Columns("A:CJ").Select
Selection.EntireColumn.Hidden = False
Rows("1:7").Delete Shift:=xlUp
Cells.Select
With Selection
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("Y2").FormulaR1C1 = _
"=IF(ISBLANK(R[1]C[-10]),CONCATENATE(RC[-1],"" "",R[1]C[-1]),RC[-1])"
Range("Y2").AutoFill Destination:=Range("Y2:Y10000"), Type:=xlFillDefault
Columns("Y:Y").Copy
Columns("Y:Y").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Columns("Y:Y").Select
Application.CutCopyMode = False
Selection.Copy
Columns("X:X").Select
ActiveSheet.Paste
Application.CutCopyMode = False

Range("AB2").FormulaR1C1 = _
"=IF(RC[-1]=""INITIALIZATION"",RC[3],IF(RC[-1]=""INSTRUCTION"",RC[5],IF(RC[-1]=""DEVELOPMENT"",RC[7],IF(RC[-1]=""OFFICIALIZATION - INDUSTRIALIZATION"",RC[9],RC[10]))))"
Range("AB2").AutoFill Destination:=Range("AB2:AB10000"), Type:=xlFillDefault
Columns("AB:AB").Copy
Columns("AB:AB").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Columns("AB:AB").Select
Application.CutCopyMode = False

Rows("1:1").Select

ActiveWindow.LargeScroll ToRight:=2

Columns("A:N").Select
Range("N1").Delete Shift:=xlToLeft
Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B2").FormulaR1C1 = "=IF(VALUE(RC[-1])=0,"""",VALUE(RC[-1]))"
Range("B2").AutoFill Destination:=Range("B2:B10000"), Type:=xlFillDefault
Columns("B:B").Copy
Columns("B:B").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Columns("A:A").Select
Range("A1").Delete Shift:=xlToLeft

ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Add Key:=Range _
("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Rows("1:1").AutoFilter
Columns("E:E").Copy
Columns("B:B").Paste
Columns("I:I").Select
Application.CutCopyMode = False
Selection.Copy
Columns("D").Paste
Columns("F:F").Select
Application.CutCopyMode = False
Selection.Copy
Columns("C:C").Paste
Application.CutCopyMode = False
Columns("M:M").Select
Application.CutCopyMode = False
Selection.Copy
Columns("F:F").Paste
Application.CutCopyMode = False
Columns("N:N").Select
Application.CutCopyMode = False
Selection.Copy
Columns("G:G").Paste
Application.CutCopyMode = False
Columns("J:J").Select
Application.CutCopyMode = False
Selection.Copy
Columns("H:H").Paste
Application.CutCopyMode = False

' Simplification contenu vierge
Sheets.Add After:=Sheets(Sheets.Count)
Sheets("vierge").Select
ActiveSheet.Range("$A$1:$O$10000").AutoFilter Field:=1, Criteria1:="<>"
Range("A1:O10000").Copy
Sheets("Feuil1").Range("A1").Paste
Application.CutCopyMode = False

Sheets("vierge").Delete
Sheets("Feuil1").Name = "vierge"

' Copie dans vierge des commentaires de la semaine précédente par reconnaissance du numéro de la FS
Range("E2").FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-4],'FS_semaine N'!R2C1:R1000C15,5,FALSE)),""NEW / à éclaircir"",VLOOKUP(RC[-4],'FS_semaine N'!R2C1:R1000C15,5,FALSE))"
Range("E2").AutoFill Destination:=Range("E2:E1000"), Type:=xlFillDefault
Columns("E:E").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

' Copie dans vierge du Type de Réseau par reconnaissance du numéro de FS
Range("I2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-8],'FS_semaine N'!R2C1:R1000C11,9,FALSE)),""NEW / à classer"",VLOOKUP(RC[-8],'FS_semaine N'!R2C1:R1000C11,9,FALSE))"
Range("I2").Select
Selection.AutoFill Destination:=Range("I2:I1000"), Type:=xlFillDefault
Columns("I:I").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

' Copie dans vierge de la Date prochain Réseau par reconnaissance de FS
Range("J2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-9],'FS_semaine N'!R2C1:R1000C11,10,FALSE)),""NEW / à programmer"",VLOOKUP(RC[-9],'FS_semaine N'!R2C1:R1000C11,10,FALSE))"
Range("J2").Select
Selection.AutoFill Destination:=Range("J2:J1000"), Type:=xlFillDefault
Columns("J:J").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

' Copie dans vierge du Nom Acheteur par reconnaissance de FS
Range("K2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-10],'FS_semaine N'!R2C1:R1000C15,11,FALSE)),"""",VLOOKUP(RC[-10],'FS_semaine N'!R2C1:R1000C15,11,FALSE))"
Range("K2").Select
Selection.AutoFill Destination:=Range("K2:K1000"), Type:=xlFillDefault
Columns("K:K").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

' Copie des Filtres GCO etc par reconaissance de FS
Range("L2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-11],'FS_semaine N'!R2C1:R1000C16,12,FALSE)),"""",VLOOKUP(RC[-11],'FS_semaine N'!R2C1:R1000C16,12,FALSE))"
Range("L2").Select
Selection.AutoFill Destination:=Range("L2:L1000"), Type:=xlFillDefault
Columns("L:L").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

' Copie Filtre PCM
Range("M2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-12],'FS_semaine N'!R2C1:R1000C16,13,FALSE)),"""",VLOOKUP(RC[-12],'FS_semaine N'!R2C1:R1000C16,13,FALSE))"
Range("M2").Select
Selection.AutoFill Destination:=Range("M2:M1000"), Type:=xlFillDefault
Columns("M:M").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

' Copie Filtre New RCO
Range("N2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-13],'FS_semaine N'!R2C1:R1000C16,14,FALSE)),"""",VLOOKUP(RC[-13],'FS_semaine N'!R2C1:R1000C16,14,FALSE))"
Range("N2").Select
Selection.AutoFill Destination:=Range("N2:N1000"), Type:=xlFillDefault
Columns("N:N").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

' Copie Filtre Transfert
Range("O2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-14],'FS_semaine N'!R2C1:R1000C16,15,FALSE)),"""",VLOOKUP(RC[-14],'FS_semaine N'!R2C1:R1000C16,15,FALSE))"
Range("O2").Select
Selection.AutoFill Destination:=Range("O2:O1000"), Type:=xlFillDefault
Columns("O:O").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

' Identification dans Semaine N des FS absentes du nouvel export
Sheets("FS_semaine N").Select
Range("F2").Select

ActiveCell.FormulaR1C1 = _
"=IF(OR(ISBLANK(RC[-5]),ISERROR(VLOOKUP(RC[-5],vierge!R2C1:R1000C9,6,FALSE))),""soldé ou abandonné"",VLOOKUP(RC[-5],vierge!R2C1:R1000C9,6,FALSE))"
Range("G2").Select
ActiveCell.FormulaR1C1 = _
"=IF(OR(ISBLANK(RC[-6]),ISERROR(VLOOKUP(RC[-6],vierge!R2C1:R1000C9,7,FALSE))),""soldé ou abandonné"",VLOOKUP(RC[-6],vierge!R2C1:R1000C9,7,FALSE))"
Range("F2:G2").Select
Selection.AutoFill Destination:=Range("F2:G1000"), Type:=xlFillDefault
Range("F2:G1000").Select

Columns("F:F").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("G:G").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("F2").Select
Sheets("vierge").Select
Columns("P:BJ").Select
Range("BJ1").Activate
Selection.Delete Shift:=xlToLeft
Range("O1").Select

' Application de Modèle sur onglet vierge
Sheets("Modèle").Select
Cells.Select
Selection.Copy
Sheets("vierge").Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Modèle").Select
Rows("1:1").Select
Selection.Copy
Sheets("vierge").Select
Rows("1:1").Select
ActiveSheet.Paste

' Décalage des onglets N-1 => N + création onglet vierge
Sheets("FS_semaine N-1").Select
Application.CutCopyMode = False
ActiveWindow.SelectedSheets.Delete
Sheets("FS_semaine N").Select
Sheets("FS_semaine N").Name = "FS_semaine N-1"
Rows("1:1").Select
Selection.AutoFilter
Sheets("vierge").Select
Sheets("vierge").Name = "FS_semaine N"
Sheets.Add After:=Sheets(Sheets.Count)
Sheets("Feuil2").Select
Sheets("Feuil2").Name = "vierge"
Sheets("FS_semaine N").Select
Rows("1:1").Select
Selection.AutoFilter

' Copie des Noms acheteur + GCO + PCM + J3J4 + UT par reconnaissance FS en N-1
Range("K2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-10],'FS_semaine N-1'!R2C1:R1000C12,11,FALSE)),"""",VLOOKUP(RC[-10],'FS_semaine N-1'!R2C1:R1000C12,11,FALSE))"
Range("K2").Select
Selection.AutoFill Destination:=Range("K2:K1000"), Type:=xlFillDefault
Range("K2:K1000").Select

Columns("K:K").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Range("L2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-11],'FS_semaine N-1'!R2C1:R1000C12,12,FALSE)),"""",VLOOKUP(RC[-11],'FS_semaine N-1'!R2C1:R1000C12,12,FALSE))"
Range("L2").Select
Selection.AutoFill Destination:=Range("L2:L1000"), Type:=xlFillDefault
Range("L2:L1000").Select

Columns("L:L").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Range("M2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-12],'FS_semaine N-1'!R2C1:R1000C15,13,FALSE)),"""",VLOOKUP(RC[-12],'FS_semaine N-1'!R2C1:R1000C15,13,FALSE))"
Range("M2").Select
Selection.AutoFill Destination:=Range("M2:M1000"), Type:=xlFillDefault
Range("M2:M1000").Select

Columns("M:M").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Range("N2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-13],'FS_semaine N-1'!R2C1:R1000C15,14,FALSE)),"""",VLOOKUP(RC[-13],'FS_semaine N-1'!R2C1:R1000C15,14,FALSE))"
Range("N2").Select
Selection.AutoFill Destination:=Range("N2:N1000"), Type:=xlFillDefault
Range("N2:N1000").Select

Columns("N:N").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Range("O2").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-14],'FS_semaine N-1'!R2C1:R1000C15,15,FALSE)),"""",VLOOKUP(RC[-14],'FS_semaine N-1'!R2C1:R1000C15,15,FALSE))"
Range("O2").Select
Selection.AutoFill Destination:=Range("O2:O1000"), Type:=xlFillDefault
Range("O2:O1000").Select

Columns("O:O").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

' Application Menus Déroulants sur Date Réseau RCO et Type Réseau
Range("J2:J1000").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:= _
"=Modèle!$J$2:$J$31"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Range("I2:I1000").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=Modèle!$I$2:$I$6"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With

' Application Menus Déroulants sur Acheteur OCM New RCO Transfert
Range("K2:K1000").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=Modèle!$H$2:$H$110"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With

Range("M2:M1000").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=Modèle!$E$2:$E$8"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With

Range("N2:N1000").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=Modèle!$D$2:$D$15"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With

' Mise en forme visuel Semaine N
Range("D2").Select
ActiveWindow.Zoom = 80
With ActiveWindow
.SplitColumn = 4
.SplitRow = 1
End With
ActiveWindow.SplitColumn = 0
ActiveWindow.SplitRow = 2
ActiveWindow.SplitRow = 1
ActiveWindow.FreezePanes = True
Range("E2").Select

' Mise à jour de l'onglet Accueil
Sheets("Accueil").Select

Range("M5").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIF('FS_semaine N'!R1C10:R997C10,Accueil!R[-1]C)"
Range("M5").Select
Selection.Copy
Range("N5:S5").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("M7").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('FS_semaine N'!R1C10:R997C10,Accueil!R[-3]C,'FS_semaine N'!R1C3:R997C3,""PEPP DV"")"
Range("M7").Select
Selection.Copy
Range("N7:S7").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("M9").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('FS_semaine N'!R1C10:R997C10,Accueil!R[-5]C,'FS_semaine N'!R1C3:R997C3,""PEPP DW"")"
Range("M9").Select
Selection.Copy
Range("N9:S9").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("M11").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('FS_semaine N'!R1C10:R997C10,Accueil!R[-7]C,'FS_semaine N'!R1C3:R997C3,""PEPP VSUD Transversal"")"
Range("M11").Select
Selection.Copy
Range("N11:S11").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("M13").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('FS_semaine N'!R3C10:R999C10,Accueil!R[-9]C,'FS_semaine N'!R3C3:R999C3,""PEPP DT-PUMA"")"
Range("M13").Select
Selection.Copy
Range("N13:S13").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWindow.LargeScroll Down:=-1
Range("M5").Select

End Sub

SAAD doli · 25 Avril 2023

AtTheOne à dit:
Bonne nuit,
Voilà ou j'en suis :

J'ai un peu épuré des données factices (arrêt de toutes les colonnes à une même ligne).
Faute de mieux je me suis référé à la plage occupée par tes données des extracts.

J'ai pris le parti de compléter les plage fusionnée avec la valeur de la première cellule de ces plages, mais il y a une imprécision s'il y a des plages fusionnées vides (elles récupéreront la valeur du dessus).

J'ai ajouter un onglet "Tables" pour placer toutes les listes qui se trouvaient dans le modèle dans des tableaux structurés.

J'ai créé des tableaux structurés "tb_SN_1" et "tb_SN"pour contenir les données de tes onglets "FS_semaine N-1" et "FS_semaine N".
Cela permet d'étendre automatiquement les formules (il...

SAAD doli · 31 Mars 2023

AtTheOne à dit:

Bonne nuit,
Voilà ou j'en suis :

J'ai un peu épuré des données factices (arrêt de toutes les colonnes à une même ligne).
Faute de mieux je me suis référé à la plage occupée par tes données des extracts.
J'ai pris le parti de compléter les plage fusionnée avec la valeur de la première cellule de ces plages, mais il y a une imprécision s'il y a des plages fusionnées vides (elles récupéreront la valeur du dessus).
J'ai ajouter un onglet "Tables" pour placer toutes les listes qui se trouvaient dans le modèle dans des tableaux structurés.
J'ai créé des tableaux structurés "tb_SN_1" et "tb_SN"pour contenir les données de tes onglets "FS_semaine N-1" et "FS_semaine N".
Cela permet d'étendre automatiquement les formules (il n'y en a pas), les formats et les validations de données. avec un style personnalisé "Style_Semaine" (uniquement le quadrillage, mais tu peux améliorer). Du coup l'onglet Modèle n'a plus lieu d'exister.
J'ai écrit les macros "Traiter_Extract_PML" et "Traiter_Extract_ALTIS" volontairement de deux façons différentes. la première en manipulant directement les objets EXCEL, la seconde en passant par des tableaux VB et en plaquant ensuite les résultats dans les tableaux structurés (en fin ou en remplacement les anciennes valeurs)

Il faut que tu répondes à mes questions du post précédent :

Voilà le texte des deux macros.
Traiter_Extract_PML

VB:

Sub Traiter_Extract_PML()
     Const ColF = 6, ColO = 15
  
     Dim Sh_PML As Worksheet, Sh_SN As Worksheet, LO As ListObject
     Dim Rg As Range, FinPML As Long, NbPML As Long
  
     With ThisWorkbook
          Set Sh_PML = .Worksheets("Vierge")
          Set Sh_SN = .Worksheets("FS_semaine N")
     End With
  
     With Sh_PML
     'Pas de lignes filtrées
          If .FilterMode Then .ShowAllData
          .AutoFilterMode = False
    'Suppr lignes d'entêtes
          .[1:6].Delete Shift:=xlUp

    'Réordonnancement des colonnes
          .[BO:PK].Delete Shift = xlToLeft
          .[AK:BM].Delete Shift = xlToLeft
          .[Q:AI].Delete Shift = xlToLeft
          .[P:P].Cut: .[E:E].Insert Shift:=xlToRight
          .[I:P].Delete Shift = xlToLeft
          .[H:H].Cut: .[F:F].Insert Shift:=xlToRight
          .[A:B].Delete Shift = xlToLeft
  
     'Lignes utiles
          FinPML = .Cells(.Rows.Count, 1).End(xlUp).Row
          NbPML = FinPML - 1
     'Sortir s'il n"y a pas de données dans la feuille "Vierge"
          If NbPML < 1 Then
               MsgBox "Pas de données dans l'Import PML" & Chr(13) & _
                       "Remplir l'onglet ""Vierge"" avec les données des fichiers score (onglet exportsingle)"
               Exit Sub
          End If
  
     ' Copie des constats : Copie dans vierge des commentaires de la semaine précédente par reconnaissance du numéro ECR
          Set Rg = .[E2].Resize(NbPML)
          Rg.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-4],'FS_semaine N'!R2C1:R" & LFin & "C15,5,FALSE),""NEW / à éclaircir"")"
          Rg.Value = Rg.Value
     ' Copie dans vierge du Type de Réseau par reconnaissance du numéro de FS
          Set Rg = .[I2].Resize(NbPML)
          Rg.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-8],'FS_semaine N'!R2C1:R" & LFin & "C15,9,FALSE),""NEW / à classer"")"
          Rg.Value = Rg.Value
     ' Copie dans vierge de la Date prochain Réseau par reconnaissance de FS
          Set Rg = .[J2].Resize(NbPML)
          Rg.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-9],'FS_semaine N'!R2C1:R" & LFin & "C15,10,FALSE),""NEW / à programmer"")"
          Rg.Value = Rg.Value
     ' Copie dans vierge du Nom Acheteur par reconnaissance de FS
          Set Rg = .[K2].Resize(NbPML)
          Rg.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-10],'FS_semaine N'!R2C1:R" & LFin & "C15,11,FALSE),"""")"
          Rg.Value = Rg.Value
     ' Copie des Filtres GCO etc par reconaissance de FS
          Set Rg = .[L2].Resize(NbPML)
          Rg.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-11],'FS_semaine N-1'!R2C1:R" & LFin & "C15,12,FALSE),"""")"
          Rg.Value = Rg.Value
     ' Copie Filtre PCM
          Set Rg = .[M2].Resize(NbPML)
          Rg.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-12],'FS_semaine N'!R2C1:R" & LFin & "C15,13,FALSE),"""")"
          Rg.Value = Rg.Value
     ' Copie Filtre J3J4
          Set Rg = .[N2].Resize(NbPML)
          Rg.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-13],'FS_semaine N'!R2C1:R" & LFin & "C15,14,FALSE),"""")"
          Rg.Value = Rg.Value
     ' Copie Filtre Transfert
          Set Rg = .[O2].Resize(NbPML)
          Rg.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-14],'FS_semaine N'!R2C1:R" & LFin & "C15,15,FALSE),"""")"
          Rg.Value = Rg.Value
    End With
  
     'FIN DE LA PREPARATION
  
     'QUE FAUT-IL FAIRE ENSUITE ?
'COLLER EN FIN DE "FS_semaine N" :
  
     'Récupérer les données dans tbVal
     tbVal = Sh_PML.Cells(2, 1).Resize(NbPML, ColO).Value
     'Supprimer la feuille "Vierge" puis en recréer une
     Sh_PML.Delete
     With ThisWorkbook: .Worksheets.Add after:=.Worksheets(.Worksheets.Count): End With
     ActiveSheet.Name = "Vierge"
  
     'Collage des valeurs en fin de tableau tb_SN
     With Sh_SN
           Déb_Import = .Cells(.Rows.Count, ColF).End(xlUp).Row + 1         '(dernière ligne repérée en colonne F +1)
           .Rows(Déb_Import).Resize(.Rows.Count - Déb_Import + 1).Delete    'Nettoyage fin de tableau (s'il y a des "résidus" au delà de la fin de la colonne F
           .Cells(Déb_Import, 1).Resize(NbPML, ColO).Value = tbVal
     End With
  
  
     Set Rg = Nothing
     Set Sh_PML = Nothing
  
End Sub

Traiter_Extract_ALTIS

VB:

Sub Traiter_Extract_ALTIS()
     'Repère des colonnes
     Const C_A = 1, C_B = 2, C_C = 3, C_D = 4, C_E = 5, C_F = 6, C_G = 7, C_H = 8, C_I = 9, C_J = 10, C_K = 11, C_L = 12, C_M = 13, C_N = 14, C_O = 15, C_P = 16, C_Q = 17, C_R = 18, C_S = 19, C_T = 20, C_U = 21, C_V = 22, C_W = 23, C_X = 24, C_Y = 25, C_Z = 26, C_AA = 27, C_AB = 28, C_AC = 29, C_AD = 30, C_AE = 31, C_AF = 32, C_AG = 33, C_AH = 34, C_AI = 35, C_AJ = 36, C_AK = 37, C_AL = 38, C_AM = 39, C_AN = 40, C_AO = 41, C_AP = 42, C_AQ = 43, C_AR = 44, C_AS = 45, C_AT = 46, C_AU = 47, C_AV = 48, C_AW = 49, C_AX = 50, C_AY = 51, C_AZ = 52, C_BA = 53, C_BB = 54, C_BC = 55, C_BD = 56, C_BE = 57, C_BF = 58, C_BG = 59, C_BH = 60, C_BI = 61, C_BJ = 62, C_BK = 63, C_BL = 64, C_BM = 65, C_BN = 66, C_BO = 67, C_BP = 68, C_BQ = 69, C_BR = 70, C_BS = 71, C_BT = 72, C_BU = 73, C_BV = 74, C_BW = 75, C_BX = 76

     Dim Sh_ALTIS As Worksheet, Sh_Accueil As Worksheet, Sh_N As Worksheet, Sh_N_1 As Worksheet
     Dim Tout, TbRés
  
     With ThisWorkbook
          Set Sh_Accueil = .Worksheets("Accueil")
          Set Sh_ALTIS = .Worksheets("Vierge")
          Set Sh_N = .Worksheets("FS_semaine N")
          Set Sh_N_1 = .Worksheets("FS_semaine N-1")
     End With
     Application.ScreenUpdating = False
  
     FormulesAccueil = Sh_Accueil.[M4:S13].Formula
     With Sh_ALTIS
     'Pas de lignes filtrées
          If .FilterMode Then .ShowAllData
          .AutoFilterMode = False
          'Récupération des données de l'extraction (à partir de la ligne 3)
          Tout = .UsedRange.Offset(2).Resize(.UsedRange.Rows.Count - 2).Value
          Application.DisplayAlerts = False: .Delete: Application.DisplayAlerts = True
     End With
     With ThisWorkbook: .Worksheets.Add after:=.Worksheets(.Worksheets.Count): End With
     ActiveSheet.Name = "Vierge"
  
     'Première ligne
     Tout(1, C_X) = IIf(Tout(2, C_O) = "", Tout(1, C_X) & " " & Tout(2, C_X), Tout(1, C_X))
     'Comptage des fiches à retenir (Col O <>"" et <>0)
     nbFiches = 0
     nbFiches = nbFiches + (Abs(Tout(1, C_O) <> "") And Tout(1, C_O) <> "0" And Tout(1, C_O) <> 0)
     'Jusqu'à l'avant-dernière
     For i = 2 To UBound(Tout) - 1
          'Compléter les valeurs des cellules fusionnées utilisées
          If Tout(i, C_S) = "" Then Tout(i, C_S) = Tout(i - 1, C_S)
          If Tout(i, C_T) = "" Then Tout(i, C_T) = Tout(i - 1, C_T)
          If Tout(i, C_AA) = "" Then Tout(i, C_AA) = Tout(i - 1, C_AA)
          If Tout(i, C_AE) = "" Then Tout(i, C_AE) = Tout(i - 1, C_AE)
          If Tout(i, C_AG) = "" Then Tout(i, C_AG) = Tout(i - 1, C_AG)
          If Tout(i, C_AI) = "" Then Tout(i, C_AI) = Tout(i - 1, C_AI)
          If Tout(i, C_AK) = "" Then Tout(i, C_AK) = Tout(i - 1, C_AK)
          If Tout(i, C_AL) = "" Then Tout(i, C_AL) = Tout(i - 1, C_AL)
          Tout(i, C_X) = IIf(Tout(i + 1, C_O) = "", Tout(i, C_X) & " " & Tout(i + 1, C_X), Tout(1, C_X))
          'Comptage des fiches à retenir (Col O <>"" et <>0)
          nbFiches = nbFiches + (Abs(Tout(i, C_O) <> "") And Tout(i, C_O) <> "0" And Tout(i, C_O) <> 0)
     Next i
     'Dernière ligne
     nbFiches = nbFiches + (Abs(Tout(i, C_O) <> "") And Tout(i, C_O) <> "0" And Tout(i, C_O) <> 0)
  
     'Dimensionnement du tableau résultat
     ReDim TbRés(C_A To nbFiches, 1 To C_O)
     j = 0
     For i = 1 To UBound(Tout)
          If Tout(i, C_O) <> "" Then
               j = j + 1
               TbRés(j, C_A) = Tout(i, C_O)
               TbRés(j, C_B) = Tout(i, C_S)
               TbRés(j, C_C) = Tout(i, C_T)
               TbRés(j, C_D) = Tout(i, C_W)
               TbRés(j, C_E) = Evaluate("=IFERROR(VLOOKUP(" & TbRés(1, C_A) & ",Tb_SN,5,FALSE),""NEW / à éclaircir"")")
               TbRés(j, C_F) = Tout(i, C_AA)
               Select Case TbRés(j, C_F)
                    Case "INITIALIZATION": TbRés(j, C_G) = Tout(i, C_AE)
                    Case "INSTRUCTION": TbRés(j, C_G) = Tout(i, C_AG)
                    Case "DEVELOPMENT": TbRés(j, C_G) = Tout(i, C_AI)
                    Case "OFFICIALIZATION - INDUSTRIALIZATION": TbRés(j, C_G) = Tout(i, C_AK)
                    Case Else: TbRés(j, C_G) = Tout(i, C_AL)
               End Select
               TbRés(j, C_I) = Tout(i, C_X)
               TbRés(j, C_J) = Evaluate("=IFERROR(VLOOKUP(" & TbRés(1, C_A) & ",Tb_SN,9,FALSE),""NEW / à classer"")")
               TbRés(j, C_K) = Evaluate("=IFERROR(VLOOKUP(" & TbRés(1, C_A) & ",Tb_SN,10,FALSE),""NEW / à programmer"")")
               TbRés(j, C_L) = Evaluate("=IFERROR(VLOOKUP(" & TbRés(1, C_A) & ",Tb_SN,11,FALSE),"""")")
               TbRés(j, C_M) = Evaluate("=IFERROR(VLOOKUP(" & TbRés(1, C_A) & ",Tb_SN,13,FALSE),"""")")
               TbRés(j, C_N) = Evaluate("=IFERROR(VLOOKUP(" & TbRés(1, C_A) & ",Tb_SN,14,FALSE),"""")")
               TbRés(j, C_O) = Evaluate("=IFERROR(VLOOKUP(" & TbRés(1, C_A) & ",Tb_SN,15,FALSE),"""")")
          End If
     Next i
  
  
     With Sh_N
          'Lectures des données de l'ancienne semaine N
          Tout = .[Tb_Sn].Value
          'Remplissage semaine N avec les données de la nouvelle extraction
          .[Tb_Sn].ClearContents
          .[Tb_Sn].ListObject.Resize .[Tb_Sn].ListObject.Range.Resize(UBound(TbRés))
          .[Tb_Sn].Value = TbRés
     End With
  
     ' Identification dans Tout des FS de l'ancienne semaine N absentes de la nouvelle extraction
     With WorksheetFunction
     For i = 1 To UBound(Tout)
          Tout(i, C_F) = Evaluate("=IFERROR(VLOOKUP(" & Tout(i, C_A) & ",Tb_SN,6,FALSE),""soldé ou abandonné"")")
          Tout(i, C_G) = Evaluate("=IFERROR(VLOOKUP(" & Tout(i, C_A) & ",Tb_SN,7,FALSE),""soldé ou abandonné"")")
     Next
     End With
  
     'Transfert vers la semaine N-1
     With Sh_N_1
          'Remplissage semaine N-1 avec les données de l'ancienne semaine N
          .[Tb_Sn_1].ClearContents
          .[Tb_Sn_1].ListObject.Resize .[Tb_Sn_1].ListObject.Range.Resize(UBound(Tout))
          .[Tb_Sn_1].Value = Tout
     End With
      Application.ScreenUpdating = True
End Sub

Macro pour filtrer les Fiches

VB:

Sub Filtrage()

     Dim Sh_SN As Worksheet, lo As ListObject
  
     'Quel bouton a appelé la macros ?
     Typ = Application.Caller
  
     Set Sh_SN = ThisWorkbook.Worksheets("FS_semaine N")
     Set lo = Sh_SN.ListObjects(1)
  
     With lo
          If .AutoFilter Is Nothing Then .Range.AutoFilter
          .AutoFilter.ShowAllData
          Select Case Typ         'En fonction du nom de l'objet qui a appelé la macro on applique les filtre adéquat
               Case "Qual_DV"
                    .Range.AutoFilter Field:=3, Criteria1:=Array("PEPP DV", "PEPP VSUD Transversal", "="), Operator:=xlFilterValues
                    .Range.AutoFilter Field:=9, Criteria1:=Array("Qualité/Indus/Communauté", "=NEW / à classer"), Operator:=xlFilterValues
               Case "Qual_DW"
                    .Range.AutoFilter Field:=3, Criteria1:=Array("PEPP DW", "PEPP VSUD Transversal", "="), Operator:=xlFilterValues
                    .Range.AutoFilter Field:=9, Criteria1:=Array("Qualité/Indus/Communauté", "NEW / à classer"), Operator:=xlFilterValues
               Case "DA_eco_DV"
                    .Range.AutoFilter Field:=3, Criteria1:=Array("PEPP DV", "PEPP VSUD Transversal", "="), Operator:=xlFilterValues
                    .Range.AutoFilter Field:=9, Criteria1:=Array("Ecotechs/Achats", "NEW / à classer"), Operator:=xlFilterValues
               Case "DA_eco_DW"
                    .Range.AutoFilter Field:=3, Criteria1:=Array("PEPP DW", "PEPP VSUD Transversal", "="), Operator:=xlFilterValues
                    .Range.AutoFilter Field:=9, Criteria1:=Array("Ecotechs/Achats", "NEW / à classer"), Operator:=xlFilterValues
          End Select
     End With
  
     Application.Goto Sh_SN.[C2], True 'Aller en haut et à gauche de la liste (avec déplacement de la fenêtre)
  
End Sub

Voir pièce jointe
Bon courage

Merci pour votre aide , je pense que c'est suffisant , je vais m'occuper pour reconstruire le code en se basant sur ce que tu as fait .
Bonne journée

SAAD doli · 25 Avril 2023

AtTheOne à dit:

Bonne nuit,
Voilà ou j'en suis :

J'ai un peu épuré des données factices (arrêt de toutes les colonnes à une même ligne).
Faute de mieux je me suis référé à la plage occupée par tes données des extracts.
J'ai pris le parti de compléter les plage fusionnée avec la valeur de la première cellule de ces plages, mais il y a une imprécision s'il y a des plages fusionnées vides (elles récupéreront la valeur du dessus).
J'ai ajouter un onglet "Tables" pour placer toutes les listes qui se trouvaient dans le modèle dans des tableaux structurés.
J'ai créé des tableaux structurés "tb_SN_1" et "tb_SN"pour contenir les données de tes onglets "FS_semaine N-1" et "FS_semaine N".
Cela permet d'étendre automatiquement les formules (il n'y en a pas), les formats et les validations de données. avec un style personnalisé "Style_Semaine" (uniquement le quadrillage, mais tu peux améliorer). Du coup l'onglet Modèle n'a plus lieu d'exister.
J'ai écrit les macros "Traiter_Extract_PML" et "Traiter_Extract_ALTIS" volontairement de deux façons différentes. la première en manipulant directement les objets EXCEL, la seconde en passant par des tableaux VB et en plaquant ensuite les résultats dans les tableaux structurés (en fin ou en remplacement les anciennes valeurs)

Il faut que tu répondes à mes questions du post précédent :

Voilà le texte des deux macros.
Traiter_Extract_PML

VB:

Sub Traiter_Extract_PML()
     Const ColF = 6, ColO = 15
 
     Dim Sh_PML As Worksheet, Sh_SN As Worksheet, LO As ListObject
     Dim Rg As Range, FinPML As Long, NbPML As Long
 
     With ThisWorkbook
          Set Sh_PML = .Worksheets("Vierge")
          Set Sh_SN = .Worksheets("FS_semaine N")
     End With
 
     With Sh_PML
     'Pas de lignes filtrées
          If .FilterMode Then .ShowAllData
          .AutoFilterMode = False
    'Suppr lignes d'entêtes
          .[1:6].Delete Shift:=xlUp

    'Réordonnancement des colonnes
          .[BO:PK].Delete Shift = xlToLeft
          .[AK:BM].Delete Shift = xlToLeft
          .[Q:AI].Delete Shift = xlToLeft
          .[P:P].Cut: .[E:E].Insert Shift:=xlToRight
          .[I:P].Delete Shift = xlToLeft
          .[H:H].Cut: .[F:F].Insert Shift:=xlToRight
          .[A:B].Delete Shift = xlToLeft
 
     'Lignes utiles
          FinPML = .Cells(.Rows.Count, 1).End(xlUp).Row
          NbPML = FinPML - 1
     'Sortir s'il n"y a pas de données dans la feuille "Vierge"
          If NbPML < 1 Then
               MsgBox "Pas de données dans l'Import PML" & Chr(13) & _
                       "Remplir l'onglet ""Vierge"" avec les données des fichiers score (onglet exportsingle)"
               Exit Sub
          End If
 
     ' Copie des constats : Copie dans vierge des commentaires de la semaine précédente par reconnaissance du numéro ECR
          Set Rg = .[E2].Resize(NbPML)
          Rg.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-4],'FS_semaine N'!R2C1:R" & LFin & "C15,5,FALSE),""NEW / à éclaircir"")"
          Rg.Value = Rg.Value
     ' Copie dans vierge du Type de Réseau par reconnaissance du numéro de FS
          Set Rg = .[I2].Resize(NbPML)
          Rg.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-8],'FS_semaine N'!R2C1:R" & LFin & "C15,9,FALSE),""NEW / à classer"")"
          Rg.Value = Rg.Value
     ' Copie dans vierge de la Date prochain Réseau par reconnaissance de FS
          Set Rg = .[J2].Resize(NbPML)
          Rg.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-9],'FS_semaine N'!R2C1:R" & LFin & "C15,10,FALSE),""NEW / à programmer"")"
          Rg.Value = Rg.Value
     ' Copie dans vierge du Nom Acheteur par reconnaissance de FS
          Set Rg = .[K2].Resize(NbPML)
          Rg.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-10],'FS_semaine N'!R2C1:R" & LFin & "C15,11,FALSE),"""")"
          Rg.Value = Rg.Value
     ' Copie des Filtres GCO etc par reconaissance de FS
          Set Rg = .[L2].Resize(NbPML)
          Rg.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-11],'FS_semaine N-1'!R2C1:R" & LFin & "C15,12,FALSE),"""")"
          Rg.Value = Rg.Value
     ' Copie Filtre PCM
          Set Rg = .[M2].Resize(NbPML)
          Rg.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-12],'FS_semaine N'!R2C1:R" & LFin & "C15,13,FALSE),"""")"
          Rg.Value = Rg.Value
     ' Copie Filtre J3J4
          Set Rg = .[N2].Resize(NbPML)
          Rg.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-13],'FS_semaine N'!R2C1:R" & LFin & "C15,14,FALSE),"""")"
          Rg.Value = Rg.Value
     ' Copie Filtre Transfert
          Set Rg = .[O2].Resize(NbPML)
          Rg.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-14],'FS_semaine N'!R2C1:R" & LFin & "C15,15,FALSE),"""")"
          Rg.Value = Rg.Value
    End With
 
     'FIN DE LA PREPARATION
 
     'QUE FAUT-IL FAIRE ENSUITE ?
'COLLER EN FIN DE "FS_semaine N" :
 
     'Récupérer les données dans tbVal
     tbVal = Sh_PML.Cells(2, 1).Resize(NbPML, ColO).Value
     'Supprimer la feuille "Vierge" puis en recréer une
     Sh_PML.Delete
     With ThisWorkbook: .Worksheets.Add after:=.Worksheets(.Worksheets.Count): End With
     ActiveSheet.Name = "Vierge"
 
     'Collage des valeurs en fin de tableau tb_SN
     With Sh_SN
           Déb_Import = .Cells(.Rows.Count, ColF).End(xlUp).Row + 1         '(dernière ligne repérée en colonne F +1)
           .Rows(Déb_Import).Resize(.Rows.Count - Déb_Import + 1).Delete    'Nettoyage fin de tableau (s'il y a des "résidus" au delà de la fin de la colonne F
           .Cells(Déb_Import, 1).Resize(NbPML, ColO).Value = tbVal
     End With
 
 
     Set Rg = Nothing
     Set Sh_PML = Nothing
 
End Sub

Traiter_Extract_ALTIS

VB:

Sub Traiter_Extract_ALTIS()
     'Repère des colonnes
     Const C_A = 1, C_B = 2, C_C = 3, C_D = 4, C_E = 5, C_F = 6, C_G = 7, C_H = 8, C_I = 9, C_J = 10, C_K = 11, C_L = 12, C_M = 13, C_N = 14, C_O = 15, C_P = 16, C_Q = 17, C_R = 18, C_S = 19, C_T = 20, C_U = 21, C_V = 22, C_W = 23, C_X = 24, C_Y = 25, C_Z = 26, C_AA = 27, C_AB = 28, C_AC = 29, C_AD = 30, C_AE = 31, C_AF = 32, C_AG = 33, C_AH = 34, C_AI = 35, C_AJ = 36, C_AK = 37, C_AL = 38, C_AM = 39, C_AN = 40, C_AO = 41, C_AP = 42, C_AQ = 43, C_AR = 44, C_AS = 45, C_AT = 46, C_AU = 47, C_AV = 48, C_AW = 49, C_AX = 50, C_AY = 51, C_AZ = 52, C_BA = 53, C_BB = 54, C_BC = 55, C_BD = 56, C_BE = 57, C_BF = 58, C_BG = 59, C_BH = 60, C_BI = 61, C_BJ = 62, C_BK = 63, C_BL = 64, C_BM = 65, C_BN = 66, C_BO = 67, C_BP = 68, C_BQ = 69, C_BR = 70, C_BS = 71, C_BT = 72, C_BU = 73, C_BV = 74, C_BW = 75, C_BX = 76

     Dim Sh_ALTIS As Worksheet, Sh_Accueil As Worksheet, Sh_N As Worksheet, Sh_N_1 As Worksheet
     Dim Tout, TbRés
 
     With ThisWorkbook
          Set Sh_Accueil = .Worksheets("Accueil")
          Set Sh_ALTIS = .Worksheets("Vierge")
          Set Sh_N = .Worksheets("FS_semaine N")
          Set Sh_N_1 = .Worksheets("FS_semaine N-1")
     End With
     Application.ScreenUpdating = False
 
     FormulesAccueil = Sh_Accueil.[M4:S13].Formula
     With Sh_ALTIS
     'Pas de lignes filtrées
          If .FilterMode Then .ShowAllData
          .AutoFilterMode = False
          'Récupération des données de l'extraction (à partir de la ligne 3)
          Tout = .UsedRange.Offset(2).Resize(.UsedRange.Rows.Count - 2).Value
          Application.DisplayAlerts = False: .Delete: Application.DisplayAlerts = True
     End With
     With ThisWorkbook: .Worksheets.Add after:=.Worksheets(.Worksheets.Count): End With
     ActiveSheet.Name = "Vierge"
 
     'Première ligne
     Tout(1, C_X) = IIf(Tout(2, C_O) = "", Tout(1, C_X) & " " & Tout(2, C_X), Tout(1, C_X))
     'Comptage des fiches à retenir (Col O <>"" et <>0)
     nbFiches = 0
     nbFiches = nbFiches + (Abs(Tout(1, C_O) <> "") And Tout(1, C_O) <> "0" And Tout(1, C_O) <> 0)
     'Jusqu'à l'avant-dernière
     For i = 2 To UBound(Tout) - 1
          'Compléter les valeurs des cellules fusionnées utilisées
          If Tout(i, C_S) = "" Then Tout(i, C_S) = Tout(i - 1, C_S)
          If Tout(i, C_T) = "" Then Tout(i, C_T) = Tout(i - 1, C_T)
          If Tout(i, C_AA) = "" Then Tout(i, C_AA) = Tout(i - 1, C_AA)
          If Tout(i, C_AE) = "" Then Tout(i, C_AE) = Tout(i - 1, C_AE)
          If Tout(i, C_AG) = "" Then Tout(i, C_AG) = Tout(i - 1, C_AG)
          If Tout(i, C_AI) = "" Then Tout(i, C_AI) = Tout(i - 1, C_AI)
          If Tout(i, C_AK) = "" Then Tout(i, C_AK) = Tout(i - 1, C_AK)
          If Tout(i, C_AL) = "" Then Tout(i, C_AL) = Tout(i - 1, C_AL)
          Tout(i, C_X) = IIf(Tout(i + 1, C_O) = "", Tout(i, C_X) & " " & Tout(i + 1, C_X), Tout(1, C_X))
          'Comptage des fiches à retenir (Col O <>"" et <>0)
          nbFiches = nbFiches + (Abs(Tout(i, C_O) <> "") And Tout(i, C_O) <> "0" And Tout(i, C_O) <> 0)
     Next i
     'Dernière ligne
     nbFiches = nbFiches + (Abs(Tout(i, C_O) <> "") And Tout(i, C_O) <> "0" And Tout(i, C_O) <> 0)
 
     'Dimensionnement du tableau résultat
     ReDim TbRés(C_A To nbFiches, 1 To C_O)
     j = 0
     For i = 1 To UBound(Tout)
          If Tout(i, C_O) <> "" Then
               j = j + 1
               TbRés(j, C_A) = Tout(i, C_O)
               TbRés(j, C_B) = Tout(i, C_S)
               TbRés(j, C_C) = Tout(i, C_T)
               TbRés(j, C_D) = Tout(i, C_W)
               TbRés(j, C_E) = Evaluate("=IFERROR(VLOOKUP(" & TbRés(1, C_A) & ",Tb_SN,5,FALSE),""NEW / à éclaircir"")")
               TbRés(j, C_F) = Tout(i, C_AA)
               Select Case TbRés(j, C_F)
                    Case "INITIALIZATION": TbRés(j, C_G) = Tout(i, C_AE)
                    Case "INSTRUCTION": TbRés(j, C_G) = Tout(i, C_AG)
                    Case "DEVELOPMENT": TbRés(j, C_G) = Tout(i, C_AI)
                    Case "OFFICIALIZATION - INDUSTRIALIZATION": TbRés(j, C_G) = Tout(i, C_AK)
                    Case Else: TbRés(j, C_G) = Tout(i, C_AL)
               End Select
               TbRés(j, C_I) = Tout(i, C_X)
               TbRés(j, C_J) = Evaluate("=IFERROR(VLOOKUP(" & TbRés(1, C_A) & ",Tb_SN,9,FALSE),""NEW / à classer"")")
               TbRés(j, C_K) = Evaluate("=IFERROR(VLOOKUP(" & TbRés(1, C_A) & ",Tb_SN,10,FALSE),""NEW / à programmer"")")
               TbRés(j, C_L) = Evaluate("=IFERROR(VLOOKUP(" & TbRés(1, C_A) & ",Tb_SN,11,FALSE),"""")")
               TbRés(j, C_M) = Evaluate("=IFERROR(VLOOKUP(" & TbRés(1, C_A) & ",Tb_SN,13,FALSE),"""")")
               TbRés(j, C_N) = Evaluate("=IFERROR(VLOOKUP(" & TbRés(1, C_A) & ",Tb_SN,14,FALSE),"""")")
               TbRés(j, C_O) = Evaluate("=IFERROR(VLOOKUP(" & TbRés(1, C_A) & ",Tb_SN,15,FALSE),"""")")
          End If
     Next i
 
 
     With Sh_N
          'Lectures des données de l'ancienne semaine N
          Tout = .[Tb_Sn].Value
          'Remplissage semaine N avec les données de la nouvelle extraction
          .[Tb_Sn].ClearContents
          .[Tb_Sn].ListObject.Resize .[Tb_Sn].ListObject.Range.Resize(UBound(TbRés))
          .[Tb_Sn].Value = TbRés
     End With
 
     ' Identification dans Tout des FS de l'ancienne semaine N absentes de la nouvelle extraction
     With WorksheetFunction
     For i = 1 To UBound(Tout)
          Tout(i, C_F) = Evaluate("=IFERROR(VLOOKUP(" & Tout(i, C_A) & ",Tb_SN,6,FALSE),""soldé ou abandonné"")")
          Tout(i, C_G) = Evaluate("=IFERROR(VLOOKUP(" & Tout(i, C_A) & ",Tb_SN,7,FALSE),""soldé ou abandonné"")")
     Next
     End With
 
     'Transfert vers la semaine N-1
     With Sh_N_1
          'Remplissage semaine N-1 avec les données de l'ancienne semaine N
          .[Tb_Sn_1].ClearContents
          .[Tb_Sn_1].ListObject.Resize .[Tb_Sn_1].ListObject.Range.Resize(UBound(Tout))
          .[Tb_Sn_1].Value = Tout
     End With
      Application.ScreenUpdating = True
End Sub

Macro pour filtrer les Fiches

VB:

Sub Filtrage()

     Dim Sh_SN As Worksheet, lo As ListObject
 
     'Quel bouton a appelé la macros ?
     Typ = Application.Caller
 
     Set Sh_SN = ThisWorkbook.Worksheets("FS_semaine N")
     Set lo = Sh_SN.ListObjects(1)
 
     With lo
          If .AutoFilter Is Nothing Then .Range.AutoFilter
          .AutoFilter.ShowAllData
          Select Case Typ         'En fonction du nom de l'objet qui a appelé la macro on applique les filtre adéquat
               Case "Qual_DV"
                    .Range.AutoFilter Field:=3, Criteria1:=Array("PEPP DV", "PEPP VSUD Transversal", "="), Operator:=xlFilterValues
                    .Range.AutoFilter Field:=9, Criteria1:=Array("Qualité/Indus/Communauté", "=NEW / à classer"), Operator:=xlFilterValues
               Case "Qual_DW"
                    .Range.AutoFilter Field:=3, Criteria1:=Array("PEPP DW", "PEPP VSUD Transversal", "="), Operator:=xlFilterValues
                    .Range.AutoFilter Field:=9, Criteria1:=Array("Qualité/Indus/Communauté", "NEW / à classer"), Operator:=xlFilterValues
               Case "DA_eco_DV"
                    .Range.AutoFilter Field:=3, Criteria1:=Array("PEPP DV", "PEPP VSUD Transversal", "="), Operator:=xlFilterValues
                    .Range.AutoFilter Field:=9, Criteria1:=Array("Ecotechs/Achats", "NEW / à classer"), Operator:=xlFilterValues
               Case "DA_eco_DW"
                    .Range.AutoFilter Field:=3, Criteria1:=Array("PEPP DW", "PEPP VSUD Transversal", "="), Operator:=xlFilterValues
                    .Range.AutoFilter Field:=9, Criteria1:=Array("Ecotechs/Achats", "NEW / à classer"), Operator:=xlFilterValues
          End Select
     End With
 
     Application.Goto Sh_SN.[C2], True 'Aller en haut et à gauche de la liste (avec déplacement de la fenêtre)
 
End Sub

Voir pièce jointe
Bon

AtTheOne à dit:

Bonne nuit,
Voilà ou j'en suis :

J'ai un peu épuré des données factices (arrêt de toutes les colonnes à une même ligne).
Faute de mieux je me suis référé à la plage occupée par tes données des extracts.
J'ai pris le parti de compléter les plage fusionnée avec la valeur de la première cellule de ces plages, mais il y a une imprécision s'il y a des plages fusionnées vides (elles récupéreront la valeur du dessus).
J'ai ajouter un onglet "Tables" pour placer toutes les listes qui se trouvaient dans le modèle dans des tableaux structurés.
J'ai créé des tableaux structurés "tb_SN_1" et "tb_SN"pour contenir les données de tes onglets "FS_semaine N-1" et "FS_semaine N".
Cela permet d'étendre automatiquement les formules (il n'y en a pas), les formats et les validations de données. avec un style personnalisé "Style_Semaine" (uniquement le quadrillage, mais tu peux améliorer). Du coup l'onglet Modèle n'a plus lieu d'exister.
J'ai écrit les macros "Traiter_Extract_PML" et "Traiter_Extract_ALTIS" volontairement de deux façons différentes. la première en manipulant directement les objets EXCEL, la seconde en passant par des tableaux VB et en plaquant ensuite les résultats dans les tableaux structurés (en fin ou en remplacement les anciennes valeurs)

Il faut que tu répondes à mes questions du post précédent :

Voilà le texte des deux macros.
Traiter_Extract_PML

VB:

Sub Traiter_Extract_PML()
     Const ColF = 6, ColO = 15
 
     Dim Sh_PML As Worksheet, Sh_SN As Worksheet, LO As ListObject
     Dim Rg As Range, FinPML As Long, NbPML As Long
 
     With ThisWorkbook
          Set Sh_PML = .Worksheets("Vierge")
          Set Sh_SN = .Worksheets("FS_semaine N")
     End With
 
     With Sh_PML
     'Pas de lignes filtrées
          If .FilterMode Then .ShowAllData
          .AutoFilterMode = False
    'Suppr lignes d'entêtes
          .[1:6].Delete Shift:=xlUp

    'Réordonnancement des colonnes
          .[BO:PK].Delete Shift = xlToLeft
          .[AK:BM].Delete Shift = xlToLeft
          .[Q:AI].Delete Shift = xlToLeft
          .[P:P].Cut: .[E:E].Insert Shift:=xlToRight
          .[I:P].Delete Shift = xlToLeft
          .[H:H].Cut: .[F:F].Insert Shift:=xlToRight
          .[A:B].Delete Shift = xlToLeft
 
     'Lignes utiles
          FinPML = .Cells(.Rows.Count, 1).End(xlUp).Row
          NbPML = FinPML - 1
     'Sortir s'il n"y a pas de données dans la feuille "Vierge"
          If NbPML < 1 Then
               MsgBox "Pas de données dans l'Import PML" & Chr(13) & _
                       "Remplir l'onglet ""Vierge"" avec les données des fichiers score (onglet exportsingle)"
               Exit Sub
          End If
 
     ' Copie des constats : Copie dans vierge des commentaires de la semaine précédente par reconnaissance du numéro ECR
          Set Rg = .[E2].Resize(NbPML)
          Rg.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-4],'FS_semaine N'!R2C1:R" & LFin & "C15,5,FALSE),""NEW / à éclaircir"")"
          Rg.Value = Rg.Value
     ' Copie dans vierge du Type de Réseau par reconnaissance du numéro de FS
          Set Rg = .[I2].Resize(NbPML)
          Rg.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-8],'FS_semaine N'!R2C1:R" & LFin & "C15,9,FALSE),""NEW / à classer"")"
          Rg.Value = Rg.Value
     ' Copie dans vierge de la Date prochain Réseau par reconnaissance de FS
          Set Rg = .[J2].Resize(NbPML)
          Rg.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-9],'FS_semaine N'!R2C1:R" & LFin & "C15,10,FALSE),""NEW / à programmer"")"
          Rg.Value = Rg.Value
     ' Copie dans vierge du Nom Acheteur par reconnaissance de FS
          Set Rg = .[K2].Resize(NbPML)
          Rg.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-10],'FS_semaine N'!R2C1:R" & LFin & "C15,11,FALSE),"""")"
          Rg.Value = Rg.Value
     ' Copie des Filtres GCO etc par reconaissance de FS
          Set Rg = .[L2].Resize(NbPML)
          Rg.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-11],'FS_semaine N-1'!R2C1:R" & LFin & "C15,12,FALSE),"""")"
          Rg.Value = Rg.Value
     ' Copie Filtre PCM
          Set Rg = .[M2].Resize(NbPML)
          Rg.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-12],'FS_semaine N'!R2C1:R" & LFin & "C15,13,FALSE),"""")"
          Rg.Value = Rg.Value
     ' Copie Filtre J3J4
          Set Rg = .[N2].Resize(NbPML)
          Rg.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-13],'FS_semaine N'!R2C1:R" & LFin & "C15,14,FALSE),"""")"
          Rg.Value = Rg.Value
     ' Copie Filtre Transfert
          Set Rg = .[O2].Resize(NbPML)
          Rg.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-14],'FS_semaine N'!R2C1:R" & LFin & "C15,15,FALSE),"""")"
          Rg.Value = Rg.Value
    End With
 
     'FIN DE LA PREPARATION
 
     'QUE FAUT-IL FAIRE ENSUITE ?
'COLLER EN FIN DE "FS_semaine N" :
 
     'Récupérer les données dans tbVal
     tbVal = Sh_PML.Cells(2, 1).Resize(NbPML, ColO).Value
     'Supprimer la feuille "Vierge" puis en recréer une
     Sh_PML.Delete
     With ThisWorkbook: .Worksheets.Add after:=.Worksheets(.Worksheets.Count): End With
     ActiveSheet.Name = "Vierge"
 
     'Collage des valeurs en fin de tableau tb_SN
     With Sh_SN
           Déb_Import = .Cells(.Rows.Count, ColF).End(xlUp).Row + 1         '(dernière ligne repérée en colonne F +1)
           .Rows(Déb_Import).Resize(.Rows.Count - Déb_Import + 1).Delete    'Nettoyage fin de tableau (s'il y a des "résidus" au delà de la fin de la colonne F
           .Cells(Déb_Import, 1).Resize(NbPML, ColO).Value = tbVal
     End With
 
 
     Set Rg = Nothing
     Set Sh_PML = Nothing
 
End Sub

Traiter_Extract_ALTIS

VB:

Sub Traiter_Extract_ALTIS()
     'Repère des colonnes
     Const C_A = 1, C_B = 2, C_C = 3, C_D = 4, C_E = 5, C_F = 6, C_G = 7, C_H = 8, C_I = 9, C_J = 10, C_K = 11, C_L = 12, C_M = 13, C_N = 14, C_O = 15, C_P = 16, C_Q = 17, C_R = 18, C_S = 19, C_T = 20, C_U = 21, C_V = 22, C_W = 23, C_X = 24, C_Y = 25, C_Z = 26, C_AA = 27, C_AB = 28, C_AC = 29, C_AD = 30, C_AE = 31, C_AF = 32, C_AG = 33, C_AH = 34, C_AI = 35, C_AJ = 36, C_AK = 37, C_AL = 38, C_AM = 39, C_AN = 40, C_AO = 41, C_AP = 42, C_AQ = 43, C_AR = 44, C_AS = 45, C_AT = 46, C_AU = 47, C_AV = 48, C_AW = 49, C_AX = 50, C_AY = 51, C_AZ = 52, C_BA = 53, C_BB = 54, C_BC = 55, C_BD = 56, C_BE = 57, C_BF = 58, C_BG = 59, C_BH = 60, C_BI = 61, C_BJ = 62, C_BK = 63, C_BL = 64, C_BM = 65, C_BN = 66, C_BO = 67, C_BP = 68, C_BQ = 69, C_BR = 70, C_BS = 71, C_BT = 72, C_BU = 73, C_BV = 74, C_BW = 75, C_BX = 76

     Dim Sh_ALTIS As Worksheet, Sh_Accueil As Worksheet, Sh_N As Worksheet, Sh_N_1 As Worksheet
     Dim Tout, TbRés
 
     With ThisWorkbook
          Set Sh_Accueil = .Worksheets("Accueil")
          Set Sh_ALTIS = .Worksheets("Vierge")
          Set Sh_N = .Worksheets("FS_semaine N")
          Set Sh_N_1 = .Worksheets("FS_semaine N-1")
     End With
     Application.ScreenUpdating = False
 
     FormulesAccueil = Sh_Accueil.[M4:S13].Formula
     With Sh_ALTIS
     'Pas de lignes filtrées
          If .FilterMode Then .ShowAllData
          .AutoFilterMode = False
          'Récupération des données de l'extraction (à partir de la ligne 3)
          Tout = .UsedRange.Offset(2).Resize(.UsedRange.Rows.Count - 2).Value
          Application.DisplayAlerts = False: .Delete: Application.DisplayAlerts = True
     End With
     With ThisWorkbook: .Worksheets.Add after:=.Worksheets(.Worksheets.Count): End With
     ActiveSheet.Name = "Vierge"
 
     'Première ligne
     Tout(1, C_X) = IIf(Tout(2, C_O) = "", Tout(1, C_X) & " " & Tout(2, C_X), Tout(1, C_X))
     'Comptage des fiches à retenir (Col O <>"" et <>0)
     nbFiches = 0
     nbFiches = nbFiches + (Abs(Tout(1, C_O) <> "") And Tout(1, C_O) <> "0" And Tout(1, C_O) <> 0)
     'Jusqu'à l'avant-dernière
     For i = 2 To UBound(Tout) - 1
          'Compléter les valeurs des cellules fusionnées utilisées
          If Tout(i, C_S) = "" Then Tout(i, C_S) = Tout(i - 1, C_S)
          If Tout(i, C_T) = "" Then Tout(i, C_T) = Tout(i - 1, C_T)
          If Tout(i, C_AA) = "" Then Tout(i, C_AA) = Tout(i - 1, C_AA)
          If Tout(i, C_AE) = "" Then Tout(i, C_AE) = Tout(i - 1, C_AE)
          If Tout(i, C_AG) = "" Then Tout(i, C_AG) = Tout(i - 1, C_AG)
          If Tout(i, C_AI) = "" Then Tout(i, C_AI) = Tout(i - 1, C_AI)
          If Tout(i, C_AK) = "" Then Tout(i, C_AK) = Tout(i - 1, C_AK)
          If Tout(i, C_AL) = "" Then Tout(i, C_AL) = Tout(i - 1, C_AL)
          Tout(i, C_X) = IIf(Tout(i + 1, C_O) = "", Tout(i, C_X) & " " & Tout(i + 1, C_X), Tout(1, C_X))
          'Comptage des fiches à retenir (Col O <>"" et <>0)
          nbFiches = nbFiches + (Abs(Tout(i, C_O) <> "") And Tout(i, C_O) <> "0" And Tout(i, C_O) <> 0)
     Next i
     'Dernière ligne
     nbFiches = nbFiches + (Abs(Tout(i, C_O) <> "") And Tout(i, C_O) <> "0" And Tout(i, C_O) <> 0)
 
     'Dimensionnement du tableau résultat
     ReDim TbRés(C_A To nbFiches, 1 To C_O)
     j = 0
     For i = 1 To UBound(Tout)
          If Tout(i, C_O) <> "" Then
               j = j + 1
               TbRés(j, C_A) = Tout(i, C_O)
               TbRés(j, C_B) = Tout(i, C_S)
               TbRés(j, C_C) = Tout(i, C_T)
               TbRés(j, C_D) = Tout(i, C_W)
               TbRés(j, C_E) = Evaluate("=IFERROR(VLOOKUP(" & TbRés(1, C_A) & ",Tb_SN,5,FALSE),""NEW / à éclaircir"")")
               TbRés(j, C_F) = Tout(i, C_AA)
               Select Case TbRés(j, C_F)
                    Case "INITIALIZATION": TbRés(j, C_G) = Tout(i, C_AE)
                    Case "INSTRUCTION": TbRés(j, C_G) = Tout(i, C_AG)
                    Case "DEVELOPMENT": TbRés(j, C_G) = Tout(i, C_AI)
                    Case "OFFICIALIZATION - INDUSTRIALIZATION": TbRés(j, C_G) = Tout(i, C_AK)
                    Case Else: TbRés(j, C_G) = Tout(i, C_AL)
               End Select
               TbRés(j, C_I) = Tout(i, C_X)
               TbRés(j, C_J) = Evaluate("=IFERROR(VLOOKUP(" & TbRés(1, C_A) & ",Tb_SN,9,FALSE),""NEW / à classer"")")
               TbRés(j, C_K) = Evaluate("=IFERROR(VLOOKUP(" & TbRés(1, C_A) & ",Tb_SN,10,FALSE),""NEW / à programmer"")")
               TbRés(j, C_L) = Evaluate("=IFERROR(VLOOKUP(" & TbRés(1, C_A) & ",Tb_SN,11,FALSE),"""")")
               TbRés(j, C_M) = Evaluate("=IFERROR(VLOOKUP(" & TbRés(1, C_A) & ",Tb_SN,13,FALSE),"""")")
               TbRés(j, C_N) = Evaluate("=IFERROR(VLOOKUP(" & TbRés(1, C_A) & ",Tb_SN,14,FALSE),"""")")
               TbRés(j, C_O) = Evaluate("=IFERROR(VLOOKUP(" & TbRés(1, C_A) & ",Tb_SN,15,FALSE),"""")")
          End If
     Next i
 
 
     With Sh_N
          'Lectures des données de l'ancienne semaine N
          Tout = .[Tb_Sn].Value
          'Remplissage semaine N avec les données de la nouvelle extraction
          .[Tb_Sn].ClearContents
          .[Tb_Sn].ListObject.Resize .[Tb_Sn].ListObject.Range.Resize(UBound(TbRés))
          .[Tb_Sn].Value = TbRés
     End With
 
     ' Identification dans Tout des FS de l'ancienne semaine N absentes de la nouvelle extraction
     With WorksheetFunction
     For i = 1 To UBound(Tout)
          Tout(i, C_F) = Evaluate("=IFERROR(VLOOKUP(" & Tout(i, C_A) & ",Tb_SN,6,FALSE),""soldé ou abandonné"")")
          Tout(i, C_G) = Evaluate("=IFERROR(VLOOKUP(" & Tout(i, C_A) & ",Tb_SN,7,FALSE),""soldé ou abandonné"")")
     Next
     End With
 
     'Transfert vers la semaine N-1
     With Sh_N_1
          'Remplissage semaine N-1 avec les données de l'ancienne semaine N
          .[Tb_Sn_1].ClearContents
          .[Tb_Sn_1].ListObject.Resize .[Tb_Sn_1].ListObject.Range.Resize(UBound(Tout))
          .[Tb_Sn_1].Value = Tout
     End With
      Application.ScreenUpdating = True
End Sub

Macro pour filtrer les Fiches

VB:

Sub Filtrage()

     Dim Sh_SN As Worksheet, lo As ListObject
 
     'Quel bouton a appelé la macros ?
     Typ = Application.Caller
 
     Set Sh_SN = ThisWorkbook.Worksheets("FS_semaine N")
     Set lo = Sh_SN.ListObjects(1)
 
     With lo
          If .AutoFilter Is Nothing Then .Range.AutoFilter
          .AutoFilter.ShowAllData
          Select Case Typ         'En fonction du nom de l'objet qui a appelé la macro on applique les filtre adéquat
               Case "Qual_DV"
                    .Range.AutoFilter Field:=3, Criteria1:=Array("PEPP DV", "PEPP VSUD Transversal", "="), Operator:=xlFilterValues
                    .Range.AutoFilter Field:=9, Criteria1:=Array("Qualité/Indus/Communauté", "=NEW / à classer"), Operator:=xlFilterValues
               Case "Qual_DW"
                    .Range.AutoFilter Field:=3, Criteria1:=Array("PEPP DW", "PEPP VSUD Transversal", "="), Operator:=xlFilterValues
                    .Range.AutoFilter Field:=9, Criteria1:=Array("Qualité/Indus/Communauté", "NEW / à classer"), Operator:=xlFilterValues
               Case "DA_eco_DV"
                    .Range.AutoFilter Field:=3, Criteria1:=Array("PEPP DV", "PEPP VSUD Transversal", "="), Operator:=xlFilterValues
                    .Range.AutoFilter Field:=9, Criteria1:=Array("Ecotechs/Achats", "NEW / à classer"), Operator:=xlFilterValues
               Case "DA_eco_DW"
                    .Range.AutoFilter Field:=3, Criteria1:=Array("PEPP DW", "PEPP VSUD Transversal", "="), Operator:=xlFilterValues
                    .Range.AutoFilter Field:=9, Criteria1:=Array("Ecotechs/Achats", "NEW / à classer"), Operator:=xlFilterValues
          End Select
     End With
 
     Application.Goto Sh_SN.[C2], True 'Aller en haut et à gauche de la liste (avec déplacement de la fenêtre)
 
End Sub

Voir pièce jointe
Bon courage

Que désigne TB_Sn ? dans la macro altis

AtTheOne · 25 Avril 2023

Bonjour à toutes & à tous, bonjour @SAAD doli
Je n'ai que mon téléphone, mais dans un de mes posts il y a :

J'ai créé des tableaux structurés "tb_SN_1" et "tb_SN"pour contenir les données de tes onglets "FS_semaine N-1" et "FS_semaine N".
Cela permet d'étendre automatiquement les formules (il n'y en a pas), les formats et les validations de données. avec un style personnalisé "Style_Semaine" (uniquement le quadrillage, mais tu peux améliorer). Du coup l'onglet Modèle n'a plus lieu d'exister.

Donc tb_SN contient les données du tableau de la feuille "FS_semaine N" ...

Comme je te l'ai dit, je ne peux rien vérifier jusqu'à vendredi
A bientôt

SAAD doli · 25 Avril 2023

AtTheOne à dit:
Bonjour à toutes & à tous, bonjour @SAAD doli
Je n'ai que mon téléphone, mais dans un de mes posts il y a :

J'ai créé des tableaux structurés "tb_SN_1" et "tb_SN"pour contenir les données de tes onglets "FS_semaine N-1" et "FS_semaine N".
Cela permet d'étendre automatiquement les formules (il n'y en a pas), les formats et les validations de données. avec un style personnalisé "Style_Semaine" (uniquement le quadrillage, mais tu peux améliorer). Du coup l'onglet Modèle n'a plus lieu d'exister.

Donc tb_SN contient les données du tableau de la feuille "FS_semaine N" ...

Comme je te l'ai dit, je ne peux rien vérifier jusqu'à vendredi
A bientôt

d'accord , mais quand je lance l'exécution , le code ne sait pas c'est quoi tb_sn puisque vous n'avez pas la déclarer comme le contenu de la page Semaine N comment je peux faire ca
ligne 84
'Lectures des données de l'ancienne semaine N
Tout = .[Tb_Sn].Value
erreur 424

vgendron · 25 Avril 2023

et encore un post en doublon !!!!!

Microsoft 365 - Erreur d'exécution '91'

Bonjour tout le monde , j'espère que vous allez bien j'ai un problème qui s'affiche quand je lance cette macro depuis un boutton censé la lancer mais quand je run la macro à partir de l'éditeur VBE rien ne s'affiche :( la ligne d'erreur est Sub Macro1() 'Prépare la feuille "Vierge"...

excel-downloads.com

SAAD doli · 25 Avril 2023

vgendron à dit:
et encore un post en doublon !!!!!

Microsoft 365 - Erreur d'exécution '91'

Bonjour tout le monde , j'espère que vous allez bien j'ai un problème qui s'affiche quand je lance cette macro depuis un boutton censé la lancer mais quand je run la macro à partir de l'éditeur VBE rien ne s'affiche :( la ligne d'erreur est Sub Macro1() 'Prépare la feuille "Vierge"...

excel-downloads.com

et Alors , ce poste est ancien et pas la même problématique

vgendron · 25 Avril 2023

Et alors???
tu as bien été capable de le retrouver pour y répondre 1 mois après la dernière réponse apportée
tu pouvais t'abstenir de créer un nouveau post pour le meme suijet !

SAAD doli · 25 Avril 2023

vgendron à dit:
Et alors???
tu as bien été capable de le retrouver pour y répondre 1 mois après la dernière réponse apportée
tu pouvais t'abstenir de créer un nouveau post pour le meme suijet !

Pardon , je sais pas si je peux poser des questions différentes pour la même problématique après définir la solution

AtTheOne · 25 Avril 2023

Bonjour @vgendron, re @SAAD doli
Cela suppose bien sûr comme je le dis, d'avoir créé le tableau structuré "tb_SN" dans la feuille "FS_semaine N" ...
Comme je te l'ai déjà dit, je ne pas en dire plus à partir de mon téléphone.
Il faudra patienter jusqu'à vendredi.
A moins qu'une bonne âme ne se penche sur ton problème !
A bientôt

Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear

SAAD doli

XLDnaute Nouveau

SAAD doli

SAAD doli

XLDnaute Nouveau

SAAD doli

XLDnaute Nouveau

AtTheOne

XLDnaute Impliqué

SAAD doli

XLDnaute Nouveau

vgendron

XLDnaute Barbatruc

Microsoft 365 - Erreur d'exécution '91'

SAAD doli

XLDnaute Nouveau

Microsoft 365 - Erreur d'exécution '91'

vgendron

XLDnaute Barbatruc

SAAD doli

XLDnaute Nouveau

AtTheOne

XLDnaute Impliqué

Discussions similaires