Copier colonne en fonction chiffre dans une autre

Question

Mon soucis est le suivant : j 'ai un gros fichier avec des lignes a copier si le chiffre de la colonne b supérieur a 1. idem pour la colonne f sans rapport entre les 2 colonnes. pour résumer si le chiffre est supérieur à 1 dans une des 2 colonnes copier la ligne dans la feuille "tableau" par avance merci avec une formule j 'y arrive mais vu la taille de mon fichier , vba semble mieux adapte et la je pèche...

Gli73 · Answer

Effectivement VBA sera beaucoup plus rapide et mieux adapté ! Un essai à tester en réel... ! ' --------------------------------------------- ' Code Commenté dans le respect du principe jmd ' (c)GLI73, 2019 ' --------------------------------------------- Sub CopierSupUn() ' Declarations des onglets en type Objet pour accelerer les traitements des onglets Dim wsMatrice As Object ' ws (pour WorkSheet) suivi du nom de l'onglet Dim wsTableau As Object ' Declaration de 2 variables "logique" pour savoir si un traitement est realisé Dim matriceVide As Boolean Dim tableauVide As Boolean ' Declaration de 2 tableaux (aans dimension - donc de type Variant - pouir pouvoir s'adapter automatiquement au volume de donnees) Dim tabMatrice() ' Tableau des donnees de l'onglet &#91;matrice&#93; Dim tabTableau() ' - contenant le resultat =&gt; sera copié dans l'onglet &#91;tableau&#93; Dim cptLig, cptCol ' Compteur de ligne et de colonne Dim colOne, colTwo ' Colonne "un" et "deux" à comparer &gt; 1 Dim nbrLig ' Nombre de ligne totalisee &gt; 1 Dim ligDeb, colDeb ' Ligne et colonne de debut des donnees dans &#91;matrice&#93; Dim ligFin, colFin ' Ligne et colonne de fin .. Dim ligRef, colRef ' Ligne et colonne de reference pour connaitre le nombre de lignes et colonnes de &#91;matrice&#93; ' Initialiser les onglets Set wsMatrice = Worksheets("matrice") Set wsTableau = Worksheets("tableau") ' Mettre les variables "traitement" a Faux ' (Nota : Theoriquement ces 2 lignes sont inutiles car les variables de type Boolean sont toujouts initialisées à Faux au moment de la déclaration) ' Mais pour plus de lisibilité dans le code on indique de cette manière "pour l'instant nous continuons le traitement" matriceVide = False tableauVide = False ' Sur l'onglet &#91;matrice&#93; ' =&gt; L'utilisation de With permet de travailler sur l'onglet sans avoir beoin de déplacmeent physique, ni d'affichage par Excel ' Ce procédé rend le code beaucoup plus rapide car l'affichage est l'un des traitements les plus lents d'Excel With wsMatrice ligDeb = 4 ' Ligne de debut des donnees ===&gt; A adapter !!!! colDeb = 1 ' idem pour la colonne de debut ligRef = 3 ' idem pour la ligne de reference colRef = 1 ' idem pour la colonne .. ' Recherher la derniere ligne de donnees ' Rows.Count permet de placer (virtuellement) le curseur sur la derniere ligne au sens Excel ' End(xlUp) permet de deplacer (virtuellement) le curseur vers le haut (xlUp) - comme avec les touches &#91;CTRL-HAUT&#93; ' Row permet de connaitre la ligne active ' ligFin pointe donc la derniere ligne "utile" des donnees de &#91;matrice&#93; ' le . (point) devant CELLS pour indiquer que les actions se déroulent sur l'onglet du WITH ligFin = .Cells(Rows.Count, colDeb).End(xlUp).Row ' Si la derniere ligne utile 'ligFIn' Est &gt; ou = à la premiere ligne des donnees Alors "il y a des donnees à traiter" If (ligFin &gt;= ligDeb) Then ' Recherher la derniere colonne de donnees ' même explication que pour ligFIn avec xlToLeft correspondant à vers la gauche comme &#91;CTRL-GAUCHE&#93; et "column(s)" pour colonne(s) ' le . (point) devant CELLS pour indiquer que les actions se déroulent sur l'onglet du WITH colFin = .Cells(ligRef, Columns.Count).End(xlToLeft).Column ' Si la derniere colonne 'colFin' Est &gt; à la premiere colonne des donnees Alors "il y a des donnees à traiter" If (colFin &gt; 1) Then colOne = 2 ' 1ere colonne de recherche ===&gt; A adapter !!!! colTwo = 3 ' 2eme colonne de recherche ===&gt; A adapter !!!! nbrLig = 0 ' pur l'instant aucune ligne n'est traitee ' Initialiser le tableau des donnees de &#91;matrice&#93; tabMatrice = Range(.Cells(ligDeb, colDeb), .Cells(ligFin, colFin)) ' Pour 'chaque ligne' de ce tableau ubound(... , 1) donne le nombre de lignes d'un tableau For cptLig = 1 To UBound(tabMatrice, 1) ' Si l'une des colonnes de recherche donne un resultat positif Alors Ajouter une ligne dans le tableau resultat If (tabMatrice(cptLig, colOne) &gt; 0) Or (tabMatrice(cptLig, colTwo) &gt; 0) Then nbrLig = nbrLig + 1 ' Une ligne de plus est triatee ' Redimensionner le tableau resultat en preservant (Preserve) les donnees precedentes ' Nota : Le tableau resultat est dimensionner à l'envers colonne,ligne et non lignee,colonne ' Cette "inversion" est obligatoire car VBA ne permet de redimensionner que la derniere dimension d'un tableau ReDim Preserve tabTableau(1 To colFin, 1 To nbrLig) ' Pour 'chaque colonne' For cptCol = 1 To colFin ' Copier dans le tbaleau resultat la donnee de cette colonne(cptCol) de cette ligne(cptLig) du tableau des donnees tabTableau(cptCol, nbrLig) = tabMatrice(cptLig, cptCol) Next ' Colonne suivante End If ' Fin Si l'une des colonnes... Next ' Ligne suivante ' Si la 1ere dimension du tableau est 0 (zero) le tableau resultat est vide car jamais redimensionner tableauVide = Not (UBound(tabTableau, 1) &gt; 0) Else ' Sinon matriceVide = True ' aucune donnee puisqu'aucune colonne End If ' Fin Si derniere colonne Else matriceVide = True ' aucune donnee puisqu'aucune ligne End If ' Fin Si dernier ligne End With ' Fin de traitement de l'onglet &#91;matrice&#93; If matriceVide Then MsgBox "La matrice est vide =&gt; Aucun traitement réalisé !", vbInformation + vbOKOnly, "Désolé" Else If tableauVide Then MsgBox "La matrice ne comporte pas d'élément à copier =&gt; Aucun traitement réalisé !", vbInformation + vbOKOnly, "Désolé" Else ' Sur l'onglet &#91;tableau&#93; (toujours sans deplacement phyisique) With wsTableau Range(.Cells(1, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, .Cells(1, Columns.Count).End(xlToLeft).Column)).ClearContents ' Resize permet de redimensionner (virtuellement) une cellule ' il faut indiquer le nombre de lignes et de colonnes pour povoir affecter les valeurs ' =&gt; Commme le tableau resultat est inversé il faut inverser aussi ce redimensionnement ' sans onublier d'inverser le tableau pour le remettre dans le bon sens (ligne/colonne) ' le . (point) devant CELLS pour indiquer que les actions se déroulent sur l'onglet du WITH .Cells(1, 1).Resize(UBound(tabTableau, 2), UBound(tabTableau, 1)) = WorksheetFunction.Transpose(tabTableau) End With ' Fin de traitement de l'onglet &#91;matrice&#93; End If ' Fin Si 'tableauVide' End If ' Fin Si 'matriceVide' ' Ne pas oublier de libérer les variables de types Objet !!! Set wsTableau = Nothing Set wsTableau = Nothing End Sub PS/ Pour les besoins du test j'ai mis &gt; 0 comme condition des test "de copie" mais il faudra les adapter selon ton besoin car ta formulation était alors que dans la PJ rien n'est &gt; 1 Salutations...

Gli73 · Answer

De rien Mais as tu réussi à adapter à ton cas précis ...

Gli73 · Answer

Donc nous avons franchi une étape ! Quant à effectivement cela peut être une prérogative importante ! Le code que je t'ai proposé est un "test de résultat" pour vérifier dans un 1er temps si nous obtenons ce que nous voulons. Maintenant il faut passer à la mise en forme ! Je regarde... et je reviens.....

Gli73 · Answer

Après lecture de ton fichier je constate que : Il n'y a pas de ligne de libellés de colonnes (Est-ce pour la confidentialité des infos) ? Car j'ai besoin dans mon code d'une "ligne de référence" pour connaitre le nombre de colonnes cf. With wsMatrice ligDeb = 4 ' Ligne de debut des donnees ===&gt; A adapter !!!! colDeb = 1 ' idem pour la colonne de debut ligRef = 3 ' idem pour la ligne de reference &lt;============= colRef = 1 ' idem pour la colonne .. ......

Gli73 · Answer

Ok pour les noms de colonnes ! 2ème étape =&gt; 2ème question la "forme originale" veut il dire le format que dans l'onglet &#91;Feuil1&#93; copié à l'identique (colonnes à copier seulement) ...