Optimisation macro

[lostheroe]

Bonjour,

Je souhaiterais savoir ci il est possible de simplifier la macro ci-dessous:

Sub Tuyautage()
Dim Cellule As Range
Dim NouveauClasseur As Workbook

'Pour chaque cellule utilisée dans la feuille idée
For Each Cellule In Worksheets("idée").UsedRange

'Si l'intérieur de la cellule utilisée est de couleur violette
If Cellule.Interior.Color = 13082801 Then

'Remplacer la valeur de cette cellule par sa valeur actuelle
Cellule.Value = Cellule.Value

'Retourner à un format de cellule sans remplissage
Cellule.Interior.Pattern = xlNone

End If

Next

'Création d'un nouveau classeur
Set NouveauClasseur = Workbooks.Add

'Couper les colonnes P jusqu'a AW dans la feuille source
ThisWorkbook.Worksheets("idée").Range("P1:AW1").EntireColumn.Cut

'Coller les colonnes dans la feuille de destination
NouveauClasseur.Worksheets("Feuil1").Range("A1").Insert

'Enregistrement du nouveau classeur dans le répertoire de l'actuel
NouveauClasseur.SaveAs ThisWorkbook.Path & "\Tuy.xlsx"

'Fermeture du nouveau classeur
NouveauClasseur.Close

'Libération de la mémoire
Set NouveauClasseur = Nothing

'Message de confirmation
MsgBox "Exécution terminée avec succès !", vbInformation

End Sub


Est il possible également de modifier cette ligne dans la macro:
'Remplacer la valeur de cette cellule par sa valeur actuelle
Cellule.Value = Cellule.Value
Par un copier et coller de la valeur arrondi à deux chiffre après la virgule.

Merci

 

[Pierrot93]

Re : Optimisation macro

Bonjour,

essaye ceci pour l'arrondi :

Cellule.Value = Round(Cellule.Value, 2)

bon après midi
@+

 

[gilbert_RGI]

Re : Optimisation macro

Bonjour,

ou ceci

Sub Tuyautage()
    Dim Cellule As Range
    Dim NouveauClasseur As Workbook

    'Pour chaque cellule utilisée dans la feuille idée
    For Each Cellule In Worksheets("idée").UsedRange
        With Cellule
            'Si l'intérieur de la cellule utilisée est de couleur violette
            If .Interior.Color = 13082801 Then

                'Remplacer la valeur de cette cellule par sa valeur actuelle
                .Value = Cellule.Value
                .NumberFormat = "0.00"
                'Retourner à un format de cellule sans remplissage
                .Interior.Pattern = xlNone

            End If
        End With
    Next

    'Création d'un nouveau classeur
    Set NouveauClasseur = Workbooks.Add

    'Couper les colonnes P jusqu'a AW dans la feuille source
    ThisWorkbook.Worksheets("idée").Range("P1:AW1").EntireColumn.Cut

    'Coller les colonnes dans la feuille de destination
    NouveauClasseur.Worksheets("Feuil1").Range("A1").Insert

    'Enregistrement du nouveau classeur dans le répertoire de l'actuel
    NouveauClasseur.SaveAs ThisWorkbook.Path & "\Tuy.xlsx"

    'Fermeture du nouveau classeur
    NouveauClasseur.Close

    'Libération de la mémoire
    Set NouveauClasseur = Nothing

    'Message de confirmation
    MsgBox "Exécution terminée avec succès !", vbInformation

End Sub

 

[ROGER2327]

Re : Optimisation macro

Bonjour à tous.

Bonjour,

essaye ceci pour l'arrondi :

Cellule.Value = Round(Cellule.Value, 2)

bon après midi
@+

... à condition de s'assurer préalablement que Cellule.Value est de type numérique.

À lostheroe : vu l'intérêt que vous portez aux réponses qui vous sont faites, je ne vais pas plus loin.​

Bonne continuation.


ℝOGER2327
#7917

Lundi 2 Gidouille 142 (Saint Lucullus, amateur (Bloomsday) - fête Suprême Quarte)
28 Prairial An CCXXIII, 5,3822h - thym
2015-W25-2T12:55:02Z


Bonne journée.

 

[lostheroe]

Re : Optimisation macro

Bonjour,

Par contre ça ne marche plus quand il s'agit de texte à copier.
Il y a des cellules avec des valeurs numériques mais également des cellules avec du texte et aussi avec du texte mais dans des cellules déroulante.


Roger: j'aurais préféré utilisé votre macro mais comme je vous l'avais déjà dis elle tourne en rond et finis par faire planter la feuille excel

 

[Pierrot93]

Re : Optimisation macro

Bonjour,

comme le disait Roger,

... à condition de s'assurer préalablement que Cellule.Value est de type numérique.

regarde du coté de la fonction "IsNumeric" pour faire un test...

bon après midi
@+

 

[lostheroe]

Re : Optimisation macro

Le problème étant que toute les cellules ne peuvent pas être de type numérique vu que certaine contienne du texte.

 

[Pierrot93]

Re : Optimisation macro

Bonjour,

Le problème étant que toute les cellules ne peuvent pas être de type numérique vu que certaine contienne du texte.

c'est pour cela je je te proposais un test avec la fonction "isnumeric"...

If IsNumeric(Cellule) Then Cellule.Value = Round(Cellule.Value, 2)

bonne journée
@+

 

[lostheroe]

Re : Optimisation macro

Merci ça marche nickel.
Par contre pour les cellules contenant des listes déroulante est-il possible de copier coller la valeur et ensuite de supprimer la liste déroulante, afin qu'il n'y est plus qu'une valeur qui apparaisse et plus de liste déroulante.

 

[Pierrot93]

Re : Optimisation macro

Re,

quel type de liste déroulante ??

 

[Pierrot93]

Re : Optimisation macro

Re,

pour une liste de validation, tu peux rajouter ceci dans ta boucle :

    cellule.Validation.Delete

 

[lostheroe]

Re : Optimisation macro

Bonjour,

Je cherche à modifier la macro ci-dessous pour rajouter un deuxième nom que je voudrais exclure de la suppression du gestionnaire de nom.
Mais j'arrive pas à la rajouter.

For Each N In ActiveWorkbook.Names
If Not N.Name Like "*Grille*" Then
N.Delete
End If
Next

Je cherche également à faire une macro pour supprimer toute les lignes vides d'une feuille excel puis de rajouter deux lignes vides entre chaque groupe de ligne supprimées.

Cordialement