Menu

Amélioration & Dynamique [Résolu]

NaXiLeAn 103 Messages postés mercredi 27 juillet 2016Date d'inscription 16 mars 2018 Dernière intervention - 7 mars 2018 à 14:13 - Dernière réponse : yg_be 5802 Messages postés lundi 9 juin 2008Date d'inscriptionContributeurStatut 21 juin 2018 Dernière intervention
- 9 mars 2018 à 19:20
Bonjour,

Une âme charitable se proposerait-elle a améliorer un code pour plus de dynamisme?
Je suis débutante, et j'utilise Excel 2016.
Mon plus gros problème est que j'ai utilisé des noms de personnes (nommé un à un) et que ma liste est susceptible d'évoluer en nombre.
J'aimerais que cette liste puisse être récupéré dans un autre fichier distinct.
Merci par avance pour votre aide.

NaXiLeAn_2.0

Sub Aude()

'Timer ON
    'Dim start As Single
    'start = Timer

'Affichage Macro ON
    Application.ScreenUpdating = False

'Calcul Formules OFF
    Application.Calculation = xlCalculationManual

'supprime_liaisons Macro
    Dim Liaisons As Variant
    Liaisons = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)

    If IsEmpty(Liaisons) = True Then Exit Sub

    For LiaisonsTrouvee = 1 To UBound(Liaisons)
    ActiveWorkbook.BreakLink _
        Name:=Liaisons(LiaisonsTrouvee), _
        Type:=xlLinkTypeExcelLinks
    Next LiaisonsTrouvee
    'ActiveWorkbook.BreakLink Name:="C:\RC\00_RC_reçue.xlsb" _
        , Type:=xlExcelLinks
        
'Derniere ligne colonne
Dim DernLigne As Long
DernLigne = Range("C" & Rows.Count).End(xlUp).Row

'Save
    ActiveWorkbook.SaveAs Filename:="C:\RC\00_RC_Modifié.xlsb"
    
'Save Forma Macro

    'ChDir "C:\RC"
    'ActiveWorkbook.SaveAs Filename:="C:\RC\00_RC_Modifié.xlsb", FileFormat _
        :=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

'Ajout colonnes
    Sheets("Volumes").Select
    ActiveWorkbook.BreakLink Name:="C:\RC\00_RC_Modifié.xlsb" _
        , Type:=xlExcelLinks
    Columns("E:F").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("E13").Select
    ActiveCell.FormulaR1C1 = "Manager"
    Range("F13").Select
    ActiveCell.FormulaR1C1 = "QMA"
    Range("E13").Select
    If ActiveSheet.FilterMode Then
    ActiveSheet.ShowAllData
    End If
        'Mise à jour formules
    Application.Calculation = xlCalculationAutomatic
    
    Range("E14").Select
    Windows("00_RC_Modifié.xlsb").Activate
    ActiveCell.FormulaR1C1 = _
        "=IFERROR(VLOOKUP(RC[-2],'C:\RC\[00_Base Données RC HSE.xlsb]Base'!C1:C13,13,FALSE),"""")"
    Range("E14").Select
    Selection.AutoFill Destination:=Range("E14:E" & DernLigne)
    Range("E14:E" & DernLigne).Select

    Range("F14").Select
    ActiveCell.FormulaR1C1 = _
        "=IFERROR(VLOOKUP(RC[-3],'C:\RC\[00_Base Données RC HSE.xlsb]Base'!C1:C18,17,FALSE),"""")"
    Range("F14").Select
    Selection.AutoFill Destination:=Range("F14:F" & DernLigne)
    Range("F14:F" & DernLigne).Select

'Mise à jour des liaisons
    ActiveWorkbook.RefreshAll
    DoEvents
    ActiveSheet.Calculate
    DoEvents
    Range("E14:E" & DernLigne).Calculate
    DoEvents
    Range("F14:F" & DernLigne).Calculate
    DoEvents
    Application.Calculation = xlCalculationManual
    
'Collage speciale valeur
    ActiveSheet.Range("E13:F" & DernLigne).Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

'SuppVide données vide en colonne Manager
    ActiveSheet.Range("$B$13:$AC$" & DernLigne).AutoFilter Field:=4, Criteria1:="="
    Range("E14:E" & DernLigne).Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.EntireRow.Delete
    Range("E13").Select
    
'Actualisation Formules colonne
    'Range("E14:F" & DernLigne).Calculate
    'Application.Calculation = xlCalculationManual
    
'Actualisation Formules classeur
    'Application.Calculate
    'Application.Calculation = xlCalculationManual
    
'Remplacer caractères
    'Range("E14:F" & DernLigne).Activate
    'Cells.Replace What:="=", Replacement:="=", LookAt:=xlPart, SearchOrder _
    '    :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

'SuppVide Macro

    'For Each c In Sheets("Volumes").Range("E14:E" & DernLigne)
    'If c = "" Then c.EntireRow.Delete
    'Next c

    'ActiveSheet.Range("$B$13:$AC$" & DernLigne).AutoFilter Field:=4, Criteria1:="="
    'Range("E14").Select
    'Range("E14:E" & DernLigne).Select
    'Selection.EntireRow.Delete
    'Range("E" & DernLigne).Select

'Tri par MR

    ActiveSheet.Range("$B$13:$AC$" & DernLigne).AutoFilter Field:=4
    ActiveWorkbook.Worksheets("Volumes").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Volumes").AutoFilter.Sort.SortFields.Add Key:= _
        Range("E13:E" & DernLigne), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Volumes").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

'Feuille Damien Heroguez

    Sheets("Volumes").Select
    Sheets("Volumes").Copy After:=Sheets(3)
    Sheets("Volumes (2)").Select
    Sheets("Volumes (2)").Name = "Damien Heroguez"
    ActiveSheet.Range("$B$13:$AC$" & DernLigne).AutoFilter Field:=4, Criteria1:=Array( _
        "Damien Lemaire", "Grégory Chiarotto", "Mounir Ounzar", "Nouveau B", _
        "Sébastien Venantvalery", "Stephane Martin", "Victoriano Marmol"), Operator:= _
        xlFilterValues
    Range("E" & DernLigne).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    ActiveSheet.Range("$B$13:$AC$" & DernLigne).AutoFilter Field:=4
    
        ActiveSheet.Range("$B$13:$AC$" & DernLigne).AutoFilter Field:=4, Criteria1:=Array( _
        "Damien Lemaire", "Grégory Chiarotto", "Mounir Ounzar", "Nouveau B", _
        "Sébastien Venantvalery", "Stephane Martin", "Victoriano Marmol"), Operator:= _
        xlFilterValues
    Range("E14").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    ActiveSheet.Range("$B$13:$AC$" & DernLigne).AutoFilter Field:=4

    
    Range("A1").Select

'Feuille Damien Lemaire

    Sheets("Volumes").Select
    Sheets("Volumes").Copy After:=Sheets(3)
    Sheets("Volumes (2)").Select
    Sheets("Volumes (2)").Name = "Damien Lemaire"
    ActiveSheet.Range("$B$13:$AC$" & DernLigne).AutoFilter Field:=4, Criteria1:=Array( _
        "Damien Heroguez", "Grégory Chiarotto", "Mounir Ounzar", "Nouveau B", _
        "Sébastien Venantvalery", "Stephane Martin", "Victoriano Marmol"), Operator:= _
        xlFilterValues
    Range("E" & DernLigne).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    ActiveSheet.Range("$B$13:$AC$" & DernLigne).AutoFilter Field:=4
    
        ActiveSheet.Range("$B$13:$AC$" & DernLigne).AutoFilter Field:=4, Criteria1:=Array( _
        "Damien Heroguez", "Grégory Chiarotto", "Mounir Ounzar", "Nouveau B", _
        "Sébastien Venantvalery", "Stephane Martin", "Victoriano Marmol"), Operator:= _
        xlFilterValues
    Range("E14").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    ActiveSheet.Range("$B$13:$AC$" & DernLigne).AutoFilter Field:=4
    
    Range("A1").Select

'Feuille Grégory Chiarotto

    Sheets("Volumes").Select
    Sheets("Volumes").Copy After:=Sheets(3)
    Sheets("Volumes (2)").Select
    Sheets("Volumes (2)").Name = "Grégory Chiarotto"
    ActiveSheet.Range("$B$13:$AC$" & DernLigne).AutoFilter Field:=4, Criteria1:=Array( _
        "Damien Heroguez", "Damien Lemaire", "Mounir Ounzar", "Nouveau B", _
        "Sébastien Venantvalery", "Stephane Martin", "Victoriano Marmol"), Operator:= _
        xlFilterValues
    Range("E" & DernLigne).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    ActiveSheet.Range("$B$13:$AC$" & DernLigne).AutoFilter Field:=4
    
        ActiveSheet.Range("$B$13:$AC$" & DernLigne).AutoFilter Field:=4, Criteria1:=Array( _
        "Damien Heroguez", "Damien Lemaire", "Mounir Ounzar", "Nouveau B", _
        "Sébastien Venantvalery", "Stephane Martin", "Victoriano Marmol"), Operator:= _
        xlFilterValues
    Range("E14").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    ActiveSheet.Range("$B$13:$AC$" & DernLigne).AutoFilter Field:=4
    
    Range("A1").Select

'Feuille Mounir Ounzar

    Sheets("Volumes").Select
    Sheets("Volumes").Copy After:=Sheets(3)
    Sheets("Volumes (2)").Select
    Sheets("Volumes (2)").Name = "Mounir Ounzar"
    ActiveSheet.Range("$B$13:$AC$" & DernLigne).AutoFilter Field:=4, Criteria1:=Array( _
        "Damien Heroguez", "Damien Lemaire", "Grégory Chiarotto", "Nouveau B", _
        "Sébastien Venantvalery", "Stephane Martin", "Victoriano Marmol"), Operator:= _
        xlFilterValues
    Range("E" & DernLigne).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    ActiveSheet.Range("$B$13:$AC$" & DernLigne).AutoFilter Field:=4
    
        ActiveSheet.Range("$B$13:$AC$" & DernLigne).AutoFilter Field:=4, Criteria1:=Array( _
        "Damien Heroguez", "Damien Lemaire", "Grégory Chiarotto", "Nouveau B", _
        "Sébastien Venantvalery", "Stephane Martin", "Victoriano Marmol"), Operator:= _
        xlFilterValues
    Range("E14").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    ActiveSheet.Range("$B$13:$AC$" & DernLigne).AutoFilter Field:=4
    
    Range("A1").Select
    
'Feuille Nouveau B

    Sheets("Volumes").Select
    Sheets("Volumes").Copy After:=Sheets(3)
    Sheets("Volumes (2)").Select
    Sheets("Volumes (2)").Name = "Nouveau B"
    ActiveSheet.Range("$B$13:$AC$" & DernLigne).AutoFilter Field:=4, Criteria1:=Array( _
        "Damien Heroguez", "Damien Lemaire", "Grégory Chiarotto", "Mounir Ounzar", _
        "Sébastien Venantvalery", "Stephane Martin", "Victoriano Marmol"), Operator:= _
        xlFilterValues
    Range("E" & DernLigne).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    ActiveSheet.Range("$B$13:$AC$" & DernLigne).AutoFilter Field:=4
    
        ActiveSheet.Range("$B$13:$AC$" & DernLigne).AutoFilter Field:=4, Criteria1:=Array( _
        "Damien Heroguez", "Damien Lemaire", "Grégory Chiarotto", "Mounir Ounzar", _
        "Sébastien Venantvalery", "Stephane Martin", "Victoriano Marmol"), Operator:= _
        xlFilterValues
    Range("E14").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    ActiveSheet.Range("$B$13:$AC$" & DernLigne).AutoFilter Field:=4
    
    Range("A1").Select
    
'Feuille Sébastien Venantvalery

    Sheets("Volumes").Select
    Sheets("Volumes").Copy After:=Sheets(3)
    Sheets("Volumes (2)").Select
    Sheets("Volumes (2)").Name = "Sébastien Venantvalery"
    ActiveSheet.Range("$B$13:$AC$" & DernLigne).AutoFilter Field:=4, Criteria1:=Array( _
        "Damien Heroguez", "Damien Lemaire", "Grégory Chiarotto", "Mounir Ounzar", _
        "Nouveau B", "Stephane Martin", "Victoriano Marmol"), Operator:= _
        xlFilterValues
    Range("E" & DernLigne).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    ActiveSheet.Range("$B$13:$AC$" & DernLigne).AutoFilter Field:=4
    
        ActiveSheet.Range("$B$13:$AC$" & DernLigne).AutoFilter Field:=4, Criteria1:=Array( _
        "Damien Heroguez", "Damien Lemaire", "Grégory Chiarotto", "Mounir Ounzar", _
        "Nouveau B", "Stephane Martin", "Victoriano Marmol"), Operator:= _
        xlFilterValues
    Range("E14").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    ActiveSheet.Range("$B$13:$AC$" & DernLigne).AutoFilter Field:=4
    
    Range("A1").Select
    
'Feuille Stephane Martin

    Sheets("Volumes").Select
    Sheets("Volumes").Copy After:=Sheets(3)
    Sheets("Volumes (2)").Select
    Sheets("Volumes (2)").Name = "Stephane Martin"
    ActiveSheet.Range("$B$13:$AC$" & DernLigne).AutoFilter Field:=4, Criteria1:=Array( _
        "Damien Heroguez", "Damien Lemaire", "Grégory Chiarotto", "Mounir Ounzar", _
        "Nouveau B", "Sébastien Venantvalery", "Victoriano Marmol"), Operator:= _
        xlFilterValues
    Range("E" & DernLigne).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    ActiveSheet.Range("$B$13:$AC$" & DernLigne).AutoFilter Field:=4
    
        ActiveSheet.Range("$B$13:$AC$" & DernLigne).AutoFilter Field:=4, Criteria1:=Array( _
        "Damien Heroguez", "Damien Lemaire", "Grégory Chiarotto", "Mounir Ounzar", _
        "Nouveau B", "Sébastien Venantvalery", "Victoriano Marmol"), Operator:= _
        xlFilterValues
    Range("E14").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    ActiveSheet.Range("$B$13:$AC$" & DernLigne).AutoFilter Field:=4
    
    Range("A1").Select
    
'Feuille Victoriano Marmol

    Sheets("Volumes").Select
    Sheets("Volumes").Copy After:=Sheets(3)
    Sheets("Volumes (2)").Select
    Sheets("Volumes (2)").Name = "Victoriano Marmol"
    ActiveSheet.Range("$B$13:$AC$" & DernLigne).AutoFilter Field:=4, Criteria1:=Array( _
        "Damien Heroguez", "Damien Lemaire", "Grégory Chiarotto", "Mounir Ounzar", _
        "Nouveau B", "Sébastien Venantvalery", "Stephane Martin"), Operator:= _
        xlFilterValues
    Range("E" & DernLigne).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    ActiveSheet.Range("$B$13:$AC$" & DernLigne).AutoFilter Field:=4
    
        ActiveSheet.Range("$B$13:$AC$" & DernLigne).AutoFilter Field:=4, Criteria1:=Array( _
        "Damien Heroguez", "Damien Lemaire", "Grégory Chiarotto", "Mounir Ounzar", _
        "Nouveau B", "Sébastien Venantvalery", "Stephane Martin"), Operator:= _
        xlFilterValues
    Range("E14").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    ActiveSheet.Range("$B$13:$AC$" & DernLigne).AutoFilter Field:=4
    
    Range("A1").Select

'Enregistrement Feuilles -> Fichiers pour envoi

'' selection des feuilles à copier
    'Sheets(Array("Damien Heroguez", "Damien Lemaire", "Grégory Chiarotto", "Mounir Ounzar", "Nouveau B", "Sébastien Venantvalery", "Stephane Martin", "Victoriano Marmol")).Select
    'Sheets("Infos Produits").Activate

' enregistrement par feuille
    Sheets("Damien Heroguez").Select
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:="c:\rc\pour envoi\" & Format(Date, "yymmdd") & "_" & Format(Time, "hhmmss") & "_" & ActiveSheet.Name
    ActiveWorkbook.Close False
    Sheets("Damien Lemaire").Select
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:="c:\rc\pour envoi\" & Format(Date, "yymmdd") & "_" & Format(Time, "hhmmss") & "_" & ActiveSheet.Name
    ActiveWorkbook.Close False
    Sheets("Grégory Chiarotto").Select
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:="c:\rc\pour envoi\" & Format(Date, "yymmdd") & "_" & Format(Time, "hhmmss") & "_" & ActiveSheet.Name
    ActiveWorkbook.Close False
    Sheets("Mounir Ounzar").Select
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:="c:\rc\pour envoi\" & Format(Date, "yymmdd") & "_" & Format(Time, "hhmmss") & "_" & ActiveSheet.Name
    ActiveWorkbook.Close False
    Sheets("Nouveau B").Select
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:="c:\rc\pour envoi\" & Format(Date, "yymmdd") & "_" & Format(Time, "hhmmss") & "_" & ActiveSheet.Name
    ActiveWorkbook.Close False
    Sheets("Sébastien Venantvalery").Select
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:="c:\rc\pour envoi\" & Format(Date, "yymmdd") & "_" & Format(Time, "hhmmss") & "_" & ActiveSheet.Name
    ActiveWorkbook.Close False
    Sheets("Stephane Martin").Select
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:="c:\rc\pour envoi\" & Format(Date, "yymmdd") & "_" & Format(Time, "hhmmss") & "_" & ActiveSheet.Name
    ActiveWorkbook.Close False
    Sheets("Victoriano Marmol").Select
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:="c:\rc\pour envoi\" & Format(Date, "yymmdd") & "_" & Format(Time, "hhmmss") & "_" & ActiveSheet.Name
    ActiveWorkbook.Close False
     
'Supprimer les onglets par MR
    'Sheets(Array("Damien Heroguez", "Stephane Martin", "Sébastien Venantvalery", "Nouveau B", _
        "Mounir Ounzar", "Grégory Chiarotto", "Damien Lemaire", "Victoriano Marmol")). _
        Select
    'ActiveWindow.SelectedSheets.Delete
'Calcul Formules ON
    Application.Calculation = xlCalculationAutomatic
    Application.Calculate

'Affichage Macro OFF
    Application.ScreenUpdating = True

'Timer OFF
    'MsgBox "durée du traitement: " & Format(Timer - start, "hh:mm:ss")

'Fermer fichier et enregistrer
    Workbooks("00_RC_Modifié.xlsb").Close True
End Sub

Afficher la suite 

Votre réponse

5 réponses

yg_be 5802 Messages postés lundi 9 juin 2008Date d'inscriptionContributeurStatut 21 juin 2018 Dernière intervention - 7 mars 2018 à 20:04
0
Merci
bonsoir, mon plus gros problème est que tu n'expliques pas ce que ton code dit réaliser.
NaXiLeAn 103 Messages postés mercredi 27 juillet 2016Date d'inscription 16 mars 2018 Dernière intervention - 8 mars 2018 à 09:53
Bonjour yg_be,
Je pensais que les lignes d'explications de mon code suffirait.
Voilà ce que réalise mon code :
depuis un tableau que je reçois, j'ajoute 2 colonnes avec des données extraites par une recherchev d'un autre classeur (Manager & QMA).
Ensuite je créé un fichier de ce même tableau par Manager avec un nom explicite comprenant le nom du Manager pour pouvoir l'envoyer tout en supprimant l'ensemble des autres lignes (y compris lignes sans Manager).
yg_be 5802 Messages postés lundi 9 juin 2008Date d'inscriptionContributeurStatut 21 juin 2018 Dernière intervention > NaXiLeAn 103 Messages postés mercredi 27 juillet 2016Date d'inscription 16 mars 2018 Dernière intervention - 8 mars 2018 à 16:06
j'imagine que ce sont les lignes 137 à 344 que tu veux améliorer et généraliser?
dans ces lignes, je vois une répétitions des mêmes actions, avec uniquement le nom de la feuille et la liste utilisée dans "autofilter" qui changent.
ai-je bien vu?
et je comprends que tu voudrais récupérer tous les éléments variables à partir d'une autre source, au lieu de les coder en dur dans ton programme.
si j'ai toujours bien compris, où souhaiterais-tu stocker ces éléments variables, et sous quelle forme, dans quel format? peut-être dans une feuille d'un classeur excel?
NaXiLeAn 103 Messages postés mercredi 27 juillet 2016Date d'inscription 16 mars 2018 Dernière intervention - 9 mars 2018 à 17:14
Bonsoir yg_be,
J'ai fait rapidement connaissance avec les boucles.
Apres 3 jours de recherches sur les forums j'en ai trouvé une qui correspondait (même si je ne l'ai pas comprise ça fonctionne.)
Merci pour l'interet.
yg_be 5802 Messages postés lundi 9 juin 2008Date d'inscriptionContributeurStatut 21 juin 2018 Dernière intervention > NaXiLeAn 103 Messages postés mercredi 27 juillet 2016Date d'inscription 16 mars 2018 Dernière intervention - 9 mars 2018 à 19:20
très bien, peux-tu alors marquer ce sujet comme résolu, via la roue dentée à droite du titre?
Commenter la réponse de yg_be