Filtre Auto: Colonne variante suite au valeur d'une Cellule

Bonjour,

je vais effectué une filtre automatique(Dans "Feuille2") pour obtenir une valeure puis la copier et la coller dans une cellue "Feuille1" , mais ce filtre avec condition que la colonne d'application et variante suite a la valeur de la cellue "DEP Num" colonne B.

Par exemple :

si Cellule "B2" (dans la feuille1) ==> Colonne du Filtre "F" sur la feulle 2 (valeur cell( "F1")=1

si Cellule "B3" (dans la feuille1) ==> Colonne du Filtre "G" sur la feulle 2 (valeur cell( "G1")=2

si Cellule "B4" (dans la feuille1) ==> Colonne du Filtre "H" sur la feulle 2(valeur cell( "H1")=3

si Cellule "B5" (dans la feuille1) ==> Colonne du Filtre "H" sur la feulle 2 (valeur cell( "I1")=4

......... etc

j'ai fait un enregistrement exemplaire dans le fichier ci joint mais je veux généralisé avec tout les celleule.

Sub SOL_Check()
'
    Sheets("offiK").Select
    ActiveSheet.Range("$A$1:$O$7068").AutoFilter Field:=1, Criteria1:="=1576", _
        Operator:=xlAnd
    ActiveSheet.Range("$A$1:$O$7068").AutoFilter Field:=8, Criteria1:="<>"
    Range("C2732").Select
    Selection.Copy
    Sheets("SOL Check").Select
    Range("D2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("offiK").ShowAllData

End Sub

Merci de m'aider.

Bonjour

Haytoch a écrit :

dans le fichier ci joint

Oups là il y a un raté

poste editer

fichier à jour

Bonjour

A vérifier

bonjour,

Merci bcp Banzai64 , c'est exactement ce que je veux merci.

juste il y a un bout de code que je comprend pas , je suis débutant en VBA , pour que je puisse adabter la macro avec le fichier de base.

 NBLigne = Application.Subtotal(103, .Columns("A"))

merci de me l'expliquer

haytoch

Bonjour

C'est l'équivalent de NBVAL en ne tenant pas compte des lignes filtrées

Regardes l'aide de SOUS.TOTAL

Pour les constantes no_fonction de 1 à 11, la fonction SOUS.TOTAL comprend les valeurs des lignes masquées par la commande Masquer les lignes dans le sous-menu Masquer et afficher de la commande Format du groupe Cellules dans l’onglet Accueil. Utilisez ces constantes pour obtenir le sous-total des nombres masqués et non masqués dans une liste. Pour les constantes no_fonction de 101 à 111, la fonction SOUS.TOTAL ignore les valeurs des lignes masquées par la commande Masquer les lignes. Utilisez ces constantes pour obtenir uniquement le sous-total des nombres non masqués d’une liste.

J'ai bien compris Merci infiniment

Problème résolut

slt

Haytoch

bonjour,

je reviens encore vers vous !

est ce que c'est possible que cette macro point vers un fichier externe a notre selection !! au lieu de copier le fichier dans une autre "Feuil" (Sheet).chaque fois . car les données que j'ai mis dans la "feuil2" sont un copier coller manuelle alors que le fichier de base et à jour chaque 3 jour !! suite a la version .

est ce que possible de le sélectionné puis la macro fait sont travail !! sans ajouter aucune feuille supplémentairement !! juste l’ouverture du fichier sélection (nouvelle version) dans le cache prendre l'information et le fermer, afin que le fichier d'analyse soit pas lourd

si se n'est pas possible , déja comme ça et trés bien .

merci

Bonjour

Je ne comprends pas trop

Haytoch a écrit :

cette macro point vers un fichier externe

La partie copier ou la partie filtre

Joins tes fichiers en indiquant clairement ce que tu veux faire (fais un exemple manuel du résultat que tu veux obtenir)

c'est la méme resultat , juste au lieu d'appliquer le filtre sur la "feuil2" , considré cette feuille comme un autre "WorkBook" (Classeur) qui subi a des mise à jour , et chaque MAJ = "autre nome du fichier"

Par exemple :

• M235689-HTK-Cond-TraB V1
• M235689-HTK-Cond-TraB V2
• M235689-HTK-Cond-TraB V3 ..............

Aussi j'ai remarquer que si le filtre afiche plus de ligne que deux . sa donne pour moi "12 résultat" mais il faut que la valeur de l'un des cellule soit afichier.

merci

Pouvez vous SVP, juste me modifier le code pour prendre en considération les lignes plus que 2 .

j'essai de modifier le code, avec un truc si les ligne sont + que 2 (NBligne > 2 )

merci d'avance

et pour la séparation pas grave je vais chercher un code pour copier coller depuis le fichier selectionné.

Bonjour

A vérifier

Banzai64 a écrit :

Joins tes fichiers en indiquant clairement ce que tu veux faire (fais un exemple manuel du résultat que tu veux obtenir)

Non ?

merci,

si je duplique une ligne dans la "feuille 2" il me donne une erreur "1004"

voiir le fichier.

la ligne coloré

par exemple :

Alot 1576 composé de deux Zones A4 et Q3 voir la colonne "Zone number" aprés filtre avec cette valeur.

merci

Bonjour

Quand j'avais testé j'avais doublé sur la ligne suivante

Remplaces la ligne correspondante

      If NBLigne > 1 Then
        .Range("C2:C" & NbLg).SpecialCells(xlCellTypeVisible).Cells(1, 1).Copy

merci sa marche bien

pour l'autre truc c'est juste de séparé les deux feuilles .

les étapes lors de l’exécution:

1- Demander où se trouve le fichier parcourir (Feuille 2 précédemment),

2-ouvrir le fichier sélectionner (en cache==>mode invisible pour l'utilisateur)

3-prendre les information nécessaire ( ce que la macro fait maintenant) sans crée aucune sheet supplimantaire. (exécution en arriére plan)

4-fermé le fichier

ci joint les fichiers séparé

Bonjour

Regardes si cela te convient

Parfait

Merci bcp

sa marche comme il faut

Banzai64 a écrit :

Bonjour

Regardes si cela te convient

est ce que

possible de comparé la valeur des cellules ?

Nombre de ligne Visible >2:

valeur des cellule

*Si même copier la valeur de la première Cellule ,

* si non :

-Résultat : "!!!!" , avec commentaire ==> "Attention!! double valeurs pour même DEP Num" & Valeur1 & Valeur2 .....

Nombre de ligne Visible = 2:

*copier la valeur de la 2éme Cellule ,

Nombre de ligne Visible = 1:

Commentaire "Pas de résultat "

Dim J As Long, NbLg As Long, NBLigne As Long
Dim Fichier
Dim WSDestin As Worksheet

  Fichier = Application.GetOpenFilename("Excel (*.xlsx), *.xlsx", , "Sélection du fichier", , False)
  If Fichier = False Then Exit Sub

  Application.ScreenUpdating = False
  Set WSDestin = Sheets("SOL Check")
  With WSDestin
    .Range("D2:E" & .Range("A" & Rows.Count).End(xlUp).Row).ClearContents
  End With

  With Workbooks.Open(Fichier)
    With .Sheets("Feuil2")
      NbLg = .Range("A" & Rows.Count).End(xlUp).Row
      For J = 2 To WSDestin.Range("A" & Rows.Count).End(xlUp).Row
        .Range("A1:O" & NbLg).AutoFilter Field:=1, Criteria1:=WSDestin.Range("A" & J)
        .Range("A1:O" & NbLg).AutoFilter Field:=5 + WSDestin.Range("B" & J), Criteria1:="<>"
        NBLigne = Application.Subtotal(103, .Columns("A"))
         NBLigne = Application.Subtotal(103, .Columns("A"))

            vcli = .Range("D3:D" & NbLg).SpecialCells(xlCellTypeVisible).Cells(1, 1)
            vclj = .Range("D3:D" & NbLg).SpecialCells(xlCellTypeVisible).Cells(NBLigne, 1)

        If NBLigne > 1 And vcli = vclj Then
        .Range("C2:C" & NbLg).SpecialCells(xlCellTypeVisible).Cells(1, 1).Copy
          WSDestin.Range("D" & J).PasteSpecial Paste:=xlPasteValues
                ElseIf NBLigne > 1 And vcli <> vclj Then

                    WSDestin.Range("D" & J) = "!!!!!"
                    WSDestin.Range("E" & J) = "Attention !! Double solution: " & vcli & " |" & vclj
                Else

          WSDestin.Range("F" & J) = "Pas de résultat"

        End If
        .ShowAllData
      Next J
    End With
    .Close savechanges:=False
  End With

j'essai d'obtenir la valeur de la dernière ligne mais la macro garde toujours même valeu, mais je n’arrive pas j'ai fait un recherche et je trouve un truc comme ça :

Sub zzzz()

Set plg = Range("A1", Cells(Cells.Find("*", , , , 2, 2).Row, Cells.Find("*", , ,

, 1, 2).Column))

MsgBox plg(plg.Count).Address

End Sub

PS : Je te déconseille fortement d'utiliser la méthode "SpecialCells" avec le

type "xlCellTypeLastCell"

Elle réserve bien des surprises car elle considère comme non vide les cellules

formatées autrement que par défaut et mémorise les précédentes

saisies/formatages mêmes s'ils ont été supprimés

Pour le fun :

Sub zzz2()

x StrReverse(Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Address)

y = """" & x & """"

MsgBox StrReverse(Left(x, Evaluate("find(""$""," & y & ",find(""$""," & y &

")+1)")))

End Sub

merci

Bonjour

Haytoch a écrit :

possible de comparé la valeur des cellules ?

Lesquelles ?

Tu fais un exemple que tu joins dans un fichier en expliquant pourquoi

Banzai64 a écrit :

Bonjour

Haytoch a écrit :

possible de comparé la valeur des cellules ?

Lesquelles ?

Tu fais un exemple que tu joins dans un fichier en expliquant pourquoi

c joint avec commentaire :