XL 2016 fonction Array

[poussy67]

Bonjour le Forum

J'ai un souci sur une VBA que j'ai copier sur le forum, qui copie et colle dans des feuilles bien précise, jusqu’à la tout fonctionne.
Quand j'insère une feuille (BD), lors du traitement les données disparaisses sauf sur une feuille1 (Z_Art_Stock). Dans la VBA il y a
If sh.Name <> "Z_Art_Stock" Then exclus la feuille lors de la mise a jour des feuilles (efface les anciens données). J'ai essaye de
ajouter le fonction Array mais sans résultat en ajoutant . Je fais appelle au pro pour un coup de pouce .

en vous remerciant d'avance

Dim pl As Range
Dim F1
Set pl = Sheets("Z_Art_Stock").Range("Base")
pl.Name = "Base"
For Each sh In Sheets

F1 = Array("Z_Art_Stock", "BD")
If sh.Name <> "F1" Then '--------------KO ne fonctionne pas
' If sh.Name <> "Z_Art_Stock" Then ' ok
With sh
.[K1] = "Mag1"
.[K2] = sh.Name
pl.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.[K1:K2], CopyToRange:=.Range("A1:J1"), Unique:=False
.[K1:K2].ClearContents
End With
End If
Next sh


Cdt poussy

 

[Lolote83]

Salut,
Il faut rajouter une petite variable compteur si j'ai bien compris la demande notée ici xCpt

    Dim pl As Range
    Dim F1
    Dim xCpt
    xCpt = 0
    Set pl = Sheets("Z_Art_Stock").Range("Base")
    pl.Name = "Base"
    For Each sh In Sheets
    
        F1 = Array("Z_Art_Stock", "BD")
        If sh.Name <> F1(xCpt) Then
            ' If sh.Name <> "Z_Art_Stock" Then ' ok
            With sh
                .[K1] = "Mag1"
                .[K2] = sh.Name
                pl.AdvancedFilter Action:=xlFilterCopy, _
                CriteriaRange:=.[K1:K2], CopyToRange:=.Range("A1:J1"), Unique:=False
                .[K1:K2].ClearContents
            End With
        End If
        xCpt = xCpt + 1
    Next sh

@+ Lolote83

 

[poussy67]

Bonjour Lolote83

j'ai essayer ton code, il me met un message d'erreur " Erreur d'execution '9' L'indice n'appartient pas à la selection.
je joint le fichier

Cdt

 

[Lolote83]

Re bonjour,
Pourquoi retrouve t-on xCpt=3 dans votre code alors que j'avais écrit xCpt=0
Cordialement
@+ Lolote83

 

[poussy67]

oui j'ai modifier le xCpt =0 à 3 pour essayer de trouver d'ou venez le problème.
j'ai oublié de le remettre à 0

 

[job75]

Bonjour poussy67, Lolote83,

Il y a bug aussi avec xCpt = 0, la variable xCpt ne va pas, il faut modifier le test If :

F1 = Array("Z_Art_Stock", "BD", "Synthèse")
For Each sh In Sheets
    If IsError(Application.Match(sh.Name, F1, 0)) Then
        With sh
            '---

A+

 

[poussy67]

Lolote83

Trop fort
impec ça marche

je te remercie beaucoup pour t'on aide

Cdt poussy

 

[job75]

Moi c'est job75 si vous avez des problèmes de vue.