Microsoft 365 VBA Creer une variable selectionnant certaines feuilles sans utiliser leur nom (nombre de feuilles jamais constant)

[trekkeur50]

Bonjour,

J'ai un fichier excel (cree a partir de macros) avec de nombreuses feuilles (crees par macros).J'ai donc 2 modules me permettant de creer ce fichier.
Dans le 3eme module, je cherche a sélectionner certaines feuilles (qui possedent des formules) .Je souhaite copier/coller valeur ces memes feuilles.
Voici un debut de macro.Je coince pour selectionner les feuilles de x a n ; Le nombre de feuille est variable et le nom des feuilles est egalement variable (le nom des feuilles reprend le nom de certaines cellules du fichier)

Sub CopColVal_Classeur()
Dim Feuille As Worksheet
COMMENT SÉLECTIONNER LES FEUILLES DE FEUIL15 à FEUIL N
(mon nombre de feuilles final n'est jamais constant)

'Application.ScreenUpdating = False
' parcours des feuilles de travail
For Each Feuille In ActiveWorkbook.Worksheets
With Feuille

' coeur de la macro
.Select
.Cells.Copy
.Cells.PasteSpecial Paste:=xlPasteValues
.Range("A1").Select

End With
Next Feuille

Application.CutCopyMode = False
'Application.ScreenUpdating = True

'supprimer feuilles inutiles
Sheets(Array("CAT", "SAISON", "Evolution semaines", "Liste magasins", "Budgets (K€)", "Width & Depth", "Ventes LW", "Stock WHS", "Stock N", "Transit", "Europe - categories", "Store - categories", "Process")).Delete
Application.ScreenUpdating = True
Sheets("Europe - stores").Select

End Sub

 

[Staple1600]

Bonjour le fil,

Une possibilité

Sub Test()
Feuilles_Valeurs_Seules Feuil3, Feuil4
End Sub

Private Sub Feuilles_Valeurs_Seules(ParamArray Sauf_Ces_Feuilles())
Dim ws As Worksheet, oBj, Flag As Boolean
For Each ws In ActiveWorkbook.Worksheets
    Flag = False
    For Each oBj In Sauf_Ces_Feuilles
        If oBj.Name = ws.Name Then
            Flag = True
            Exit For
        End If
    Next
    If Not Flag Then
    ws.UsedRange = ws.UsedRange.Value
    End If
Next ws
End Sub

Explications:
Dans cet exemple, toutes les feuilles passeront en valeurs seules sauf les feuilles Feuil3 et Feuil4
NB: Ces sont les Code Name des feuilles
(pas le nom affiché sur l'onglet)

 

[trekkeur50]

Merci une nouvelle fois Staple pour ta reponse.
J'ai le message suivant lorsque je lance la macro :
"Erreur d'execution 1004"
nous ne pouvons pas modifier les cellules selectionnées car cela affecterait un tableau croisé dynamique..."

As tu une idée de ce que cela signifie ?

En effet, j'ai des tableaux croises dynamiques (que j'ai utilisé pour creer des feuilles de calcul, mais je souhaite les supprimer en fin de macro) et ne conserver que certaines feuilles.
Bref ta macro me convenait parfaitement

 

[Staple1600]

Re

Il n'était pas question de TCD présents dans le 1er message.
J'ai donc proposé un code rédigé en conséquence...

 

[Staple1600]

Re

Donc le code précédent adapté en cas de TCD dans le classeur
(test OK sur mon PC)

Sub Test()
Feuilles_Valeurs_Seules Feuil3, Feuil4
End Sub

Private Sub Feuilles_Valeurs_Seules(ParamArray Sauf_Ces_Feuilles())
Dim ws As Worksheet, oBj, Flag As Boolean
For Each ws In ActiveWorkbook.Worksheets
    Flag = False
    For Each oBj In Sauf_Ces_Feuilles
        If oBj.Name = ws.Name Then
            Flag = True
            Exit For
        End If
    Next
    If Not Flag Then
    If ws.PivotTables().Count > 0 Then
    ws.Cells.Copy
    ws.Cells(1).PasteSpecial xlValues
    Application.CutCopyMode = False
    Else
    ws.UsedRange = ws.UsedRange.Value
    End If
    End If
Next ws
End Sub

 

[eriiic]

Bonjour,

autre possibilité, ajouter une propriété personnalisée à la création de la feuille.
Ca permettra d'éviter des dégats si une feuille est ajoutée et le code non adapté.
A la création :

ActiveSheet.CustomProperties.Add Name:="Tag", Value:="ok"

Utilisation :

Sub test()
    Dim sh As Worksheet
    For Each sh In Worksheets
        If sh.CustomProperties.Count > 0 Then
            If sh.CustomProperties.Item(1) = "ok" Then
                ' copier-coller valeurs
                ' voir proposition Staple
            End If
        End If
    Next sh
End Sub

eric

 

[trekkeur50]

Merci Messieurs.
Je suis parti sur l'idée de Staple.C'est exactement ce que je recherchais

 

[Staple1600]

Bonjour le fil, Bonjour trekkeur50, eriiiic

•>trekkeur50
Donc problème résolu?
Cela fonctionne chez toi (avec tes TCD) ?
cf code VBA posté dans le message#5

 

[trekkeur50]

Ca fonctionne tres bien avec les TCD (je ne me doutais pas du tout qu'il fallait un code different pour les TCD)
Je n'arrive pas à trouver ou mettre resolu sur le post

 

[Staple1600]

Re

Rien ne t'oblige à mettre ton post résolu
Moi, je voulais juste savoir si le code que je t'ai proposé au message#5 fonctionnait sur ton "vrai" fichier"

 

[trekkeur50]

Staple,

J'ai recuperé ta macro et ajouté quelques lignes (supprimer feuilles inutiles)
Je n'arrive pas a solutionner un probleme.
Lorsque le message "enregistrer le fichier", et apres avoir fait OK, j'ai un message qui apparait :"erreur d'execution 13, incompatibilité de type"
La macro ne s'arrete pas a la ligne msgbox mais repart sur la 1ere ligne de la macro et c'est la que ca bug (le resultat final est bon mais je voudrais juste eviter ce message de bug)

(Pour t'expliquer le contexte: j'ai plusieurs macros qui s'enchainent, dont celle ci dessous qui est la derniere.J'ai un dernier module qui avec la fonction call me permet de les enchainer)
Si tu as une idée, elle est comme d'habitude la bienvenue

Sub Coller_Valeur()
Feuilles_Valeurs_Seules Feuil10, Feuil11, Feuil12, Feuil13, Feuil14, Feuil7
End Sub

Private Sub Feuilles_Valeurs_Seules(ParamArray Sauf_Ces_Feuilles())
Dim ws As Worksheet, oBj, Flag As Boolean
For Each ws In ActiveWorkbook.Worksheets
Flag = False
For Each oBj In Sauf_Ces_Feuilles
If oBj.Name = ws.Name Then
Flag = True
Exit For
End If
Next
If Not Flag Then
If ws.PivotTables().Count > 0 Then
ws.Cells.Copy
ws.Cells(1).PasteSpecial xlValues
Application.CutCopyMode = False
Else
ws.UsedRange = ws.UsedRange.Value
End If
End If
Next ws

'supprimer feuilles inutiles
Application.DisplayAlerts = False
Sheets(Array("CAT", "SAISON", "Evolution semaines", "Liste magasins", "Budgets (K€)", "Width & Depth", "Ventes LW", "Stock WHS", "Stock N", "Transit", "Europe - categories", "Store - categories", "Process")).Delete
MsgBox "Enregistrer le fichier"

End Sub

 

[Staple1600]

Bonjour le fil, trekkeur50

•>trekkeur50
Relire, stp, le message#2
Et notamment le NB
(en bas et en gras)