Sujet Précédent Sujet Suivant

Amélioration & Dynamique

Résolu
NaXiLeAn Messages postés 122 Statut Membre -  
yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   -
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

1 réponse

Réponse 1 / 1
yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   Ambassadeur 1 587
 
bonsoir, mon plus gros problème est que tu n'expliques pas ce que ton code dit réaliser.
0
NaXiLeAn Messages postés 122 Statut Membre 1
 
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).
0
yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 587 > NaXiLeAn Messages postés 122 Statut Membre
 
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?
0
NaXiLeAn Messages postés 122 Statut Membre 1
 
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.
0
yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 587 > NaXiLeAn Messages postés 122 Statut Membre
 
très bien, peux-tu alors marquer ce sujet comme résolu, via la roue dentée à droite du titre?
0

Discussions similaires

Impossible d'afficher le rapport de tableau croisé dynamique sur un rapport
Utilisateur anonyme -
TomH. -

13 réponses
Nom de champs du tableau croisé dynamique non valide
Kazooie123 -
SajDri -

6 réponses
IP dynamique sous freebox
Camille -
sfdsf -

29 réponses
Réseau Fibre Free - IP dynamique
Balyrux -
Balyrux -

9 réponses
Changer d'IP avec Free
Leaaah -
jee pee -

23 réponses