Copier des lignes avec certaines valeurs d'un onglet à l'autre

Neruda

XLDnaute Nouveau
Bonjour,

J'ai sur un onglet une liste de critères.
Le numéro du critère en A1
Le texte du critère en B1
Le statut du critère en C1 (il peut être "C" ou "NC")

Comment récupérer seulement ceux qui sont NC,
copier dans un autre onglet seulement les cellules A et B de chaque critère NC,
(en insérant le nombre de lignes nécessaires) ?

Si quelqu'un peut m'aider svp

Merci
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonsoir Neruda,
Un essai en PJ.
J'ai ajouté deux choses :
1- L'archivage des NC sont datées
2- Je supprime les NC de la base.
VB:
Sub Archive()
DerLig = Range("A65500").End(xlUp).Row
For i = 2 To DerLig
    If Cells(i, "C") = "NC" Then
        LigNC = 1 + Sheets("NC").Range("A65500").End(xlUp).Row
        Sheets("NC").Cells(LigNC, 1) = Now          ' Insere date d'archivage
        Sheets("NC").Cells(LigNC, 2) = Cells(i, 1)  ' N°
        Sheets("NC").Cells(LigNC, 3) = Cells(i, 2)  ' Critère
        Rows(Cells(i, 1).Row).Delete shift:=xlUp    ' Supprime la ligne
    End If
Next i
End Sub
 

Pièces jointes

  • Classeur1.xlsm
    17.2 KB · Affichages: 15

Neruda

XLDnaute Nouveau
Bonjour,

Le script est parfait, merci.
Il copie les lignes à la fin de ma feuille de destination.
Mais est-il possible de les insérer à partir de la ligne 22 (sans effacer ce qui vient après la ligne 22, c'est-à-dire en ajoutant des lignes.

Et que signifie "B65500" svp ?

Je l'ai juste un peu modifié car je dois conserver les critères sur l'autre feuille et je n'ai pas besoin de la date :
VB:
Option VBASupport 1
Sub Archive()
DerLig = Range("B65500").End(xlUp).Row
For i = 2 To DerLig
    If Cells(i, "D") = "NC" Then
        LigNC = 1 + Sheets("Declaration").Range("B65500").End(xlUp).Row
        Sheets("Declaration").Cells(LigNC, 1) = Cells(i, 2)  ' N°
        Sheets("Declaration").Cells(LigNC, 2) = Cells(i, 3)  ' Critère
    End If
Next i
End Sub

Merci
 

Neruda

XLDnaute Nouveau
Cela les ajoute après la dernière ligne écrite en bas de la feuille,
j'ai pourtant laissé 2 lignes vides après la ligne 22,
je vais essayer de trouver mais n'hésitez pas si vous avez une idée,

Merci encore
 
Dernière édition:

sylvanu

XLDnaute Barbatruc
Supporter XLD
Si c'est uniquement en ligne 22 que vous voulez insérer alors utilisez :
VB:
Rows("22:22").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
et supprimer la ligne
Code:
LigNC = 1 + Sheets("Declaration").Range("B65500").End(xlUp).Row
cela pourrait donner :
Code:
Sub Archive()
DerLig = Range("B65500").End(xlUp).Row
For i = 2 To DerLig
    If Cells(i, "D") = "NC" Then
        Rows("22:22").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Sheets("Declaration").Cells(22, 1) = Cells(i, 2)  ' N°
        Sheets("Declaration").Cells(22, 2) = Cells(i, 3)  ' Critère
    End If
Next i
End Sub
Si tant est que cela soit ce que vous voulez faire.
 

Neruda

XLDnaute Nouveau
en fait le code précédent ne me copiait qu'une ligne sur la ligne 22 de ma page de destination,
en revanche il créait des nouvelles lignes vides à partir de la page 22 de la feuille d'origine,
je vais bien regarder votre nouveau fichier,
Merci
 

Neruda

XLDnaute Nouveau
Bonjour,

Merci pour le script, il convient tout à fait et insère bien les données à partir de la ligne 22 en ajoutant de nouvelles lignes.
Mais il remonte les critères en inversant leur ordre de classement, pourriez-vous m'indiquer comment rétablir l'ordre d'origine svp ?
J'aimerais aussi ajouter la date de génération de cette liste avec ce format : Dimanche 11 octobre en cellule C29, mais je ne vois pas comment faire et surtout comme cette cellule va changer de numéro de ligne car les critères sont ajoutés à partir de la ligne 22 et vont donc décaler tout le contenu suivant.

Merci

VB:
Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Sub Archive()
DerLig = Range("B65500").End(xlUp).Row
For i = 2 To DerLig
    If Sheets("Criteres").Cells(i, "D") = "NC" Then
        With Sheets("Declaration")
            .Rows("22:22").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            .Cells(22, 1) = Sheets("Criteres").Cells(i, 2)  ' N°
            .Cells(22, 2) = Sheets("Criteres").Cells(i, 3)  ' Critère
        End With
    End If
Next i
End Sub
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour,
Evidemment, si à chaque fois vous insérez en ligne 22, le résultat sera en ordre inverse.
Dans ce cas il faut incrémenter le N° ligne où insérer :
VB:
Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Sub Archive()
DerLig = Range("B65500").End(xlUp).Row
For i = 2 To DerLig
    If Sheets("Criteres").Cells(i, "D") = "NC" Then
        With Sheets("Declaration")
            Ligne = 20 + i ' Ligne 22 + i - 2 car i commence à 2
            .Rows(Ligne).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            .Cells(Ligne, 1) = Sheets("Criteres").Cells(i, 2)  ' N°
            .Cells(Ligne, 2) = Sheets("Criteres").Cells(i, 3)  ' Critère
        End With
    End If
Next i
 Sheets("Declaration").Range("C29") = Format(Date, "dddd dd mmmm yyyy")
End Sub
J'ai mis la date en C29 mais n'ai pas tout compris au pourquoi du comment, à vous de modifier en conséquence.
 

Neruda

XLDnaute Nouveau
Bonjour,

Avec cette modification j'ai bien l'ordre qui est rétabli, mais au lieu de bien les insérer en créant les lignes et en décalant les contenus suivants comme précédemment, les lignes s'ajoutent de façon aléatoire au sein du contenu suivant sans les remplacer. En décalant aussi les contenus mais les critères ne se suivent plus et sont noyés dans les contenus suivants.

Merci
 

Discussions similaires

Réponses
5
Affichages
335
Compte Supprimé 979
C

Statistiques des forums

Discussions
311 724
Messages
2 081 936
Membres
101 844
dernier inscrit
pktla