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

trekkeur50

XLDnaute Junior
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

XLDnaute Barbatruc
Bonjour le fil,

Une possibilité
VB:
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

XLDnaute Junior
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

1585491524551.png
 

Staple1600

XLDnaute Barbatruc
Re

Donc le code précédent adapté en cas de TCD dans le classeur
(test OK sur mon PC)
VB:
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

XLDnaute Barbatruc
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 :
VB:
ActiveSheet.CustomProperties.Add Name:="Tag", Value:="ok"
Utilisation :
VB:
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

XLDnaute Junior
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
 

Statistiques des forums

Discussions
311 730
Messages
2 081 981
Membres
101 855
dernier inscrit
alexis345