IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Déplacer une ligne dans une autre feuille en fonction d'un critère


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre confirmé
    Profil pro
    Inscrit en
    Août 2011
    Messages
    115
    Détails du profil
    Informations personnelles :
    Localisation : Belgique

    Informations forums :
    Inscription : Août 2011
    Messages : 115
    Par défaut Déplacer une ligne dans une autre feuille en fonction d'un critère
    * Bonjour *

    Comment je peux coder ceci? Si une cellule de la colonne A dans la feuil1 contient le caractère "x", alors coupe toute la ligne (qui contient le "x") dans la prochaine ligne non vide de la feuil2, et supprime l’ancienne ligne.
    je sais que ce que je veux ressemble à ce code, mais j'ai un peu de difficulté.
    Merci


    Citation Envoyé par SilkyRoad Voir le message
    bonsoir


    Tu peux essayer d'adapter cette macro:
    (j'ai interprété que tu souhaites copier à la suite de la derniere ligne non vide dans le classeur de destination)

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    Dim WBSource As Workbook, WBDest As Workbook
    Dim i As Integer
     
    Set WBSource = Workbooks("Classeur1")
    Set WBDest = Workbooks("Classeur2")
     
    'cherche la ligne vide dans le classeur de destination
    i = WBDest.Worksheets(1).Range("A65536").End(xlUp).Row + 1
     
    'Copie la 2eme ligne de la premiere feuille dans le classeur source.
    'Colle la ligne à la suite de la derniere ligne non vide dans le classeur de
    'destination.
    WBSource.Worksheets(1).Rows(2).Copy _
        Destination:=WBDest.Worksheets(1).Cells(i, 1)
     
    'Suppression de la ligne dans le classeur source
    WBSource.Worksheets(1).Rows(2).Delete
     
    'Désactive le mode Couper/Copier
    Application.CutCopyMode = False

    michel

  2. #2
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Billets dans le blog
    8
    Par défaut heu
    bonjour

    dans l' exemple que tu a donné tu travaille sur 2 classeurs est ce bien le cas pour toi ?

    au plaisir
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  3. #3
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    Bonjour
    Ce passage n'est pas clair
    alors coupe toute la ligne (qui contient le "x") dans la prochaine ligne non vide de la feuil2, et supprime l’ancienne ligne.
    Néanmoins, si tu as plusieurs lignes contenant x en colonne A de Feuil1 que tu veux transférer vers la première ligne vide de Feuil2, il serait plus utile d'utiliser un filtre automatique
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    Sub Transfert()
    Dim LastLig As Long
    Dim cDest As Range
     
    Application.ScreenUpdating = False
    With ThisWorkbook
        'cDest: La celllule de destination: première cellule vide de la colonne A de Feuil2
        With .Worksheets("Feuil2")
            Set cDest = .Cells(.Rows.Count, "A").End(xlUp)(2)
        End With
        With .Worksheets("Feuil1")
            'Enlève l'éventuel filtre automatique
            .AutoFilterMode = False
            'LastLig, ligne de la dernière cellule remplie de colonne A de Feuil1
            LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
            'On fait un filtre automatique sur la colonne A de Feuil1 avec comme critère "x"
            .Range("A1:A" & LastLig).AutoFilter field:=1, Criteria1:="x"
            'Si au moins une ligne résultat du filtre (en plus de la ligne 1 des titres)
            If .Range("A1:A" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then
                With .Range("A2:A" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow
                    'On copie toutes les lignes visibles vers cDest (sauf la ligne des titres)
                    .Copy cDest
                    'on supprime toutes les lignes visibles (sauf la ligne des titres)
                    .Delete
                End With
            End If
            'on vide notre variable cDest
            Set cDest = Nothing
            'On enlève le filtre automatique
            .AutoFilterMode = False
        End With
    End With
    End Sub
    Si tu as seulement une seul et unique cellule contenant x en colonne A de Feuil1 et que tu veux transférer cette ligne vers la première cellule vide de colonne A de Feuil2, on passera pas la méthode Find. Exemple:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    Sub Transfert2()
    Dim c As Range, cDest As Range
     
    Application.ScreenUpdating = False
    With ThisWorkbook
        'cDest: La celllule de destination: première cellule vide de la colonne A de Feuil2
        With .Worksheets("Feuil2")
            Set cDest = .Cells(.Rows.Count, "A").End(xlUp)(2)
        End With
        With .Worksheets("Feuil1")
        'on cherche LA CELLULE contenant x en colonne A de Feuil1
            Set c = .Range("A:A").Find("x", LookIn:=xlValues, lookat:=xlWhole)
            If Not c Is Nothing Then
                With c.EntireRow
                    'On copie toute la ligne trouvée vers cDest
                    .Copy cDest
                    'on supprime la ligne trouvée de Feuil1
                    .Delete
                End With
                Set c = Nothing
            End If
            'on vide notre variable cDest
            Set cDest = Nothing
        End With
    End With
    End Sub

  4. #4
    Membre confirmé
    Profil pro
    Inscrit en
    Août 2011
    Messages
    115
    Détails du profil
    Informations personnelles :
    Localisation : Belgique

    Informations forums :
    Inscription : Août 2011
    Messages : 115
    Par défaut ça marche!
    Merci beaucoup!

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. copié une ligne d'une table dans une autre
    Par Invité dans le forum Requêtes
    Réponses: 1
    Dernier message: 21/11/2009, 20h48
  2. Réponses: 4
    Dernier message: 15/10/2009, 13h33
  3. [E-00] Syntaxe pour insérer une ligne ou une colonne dans une feuille
    Par Benjycool dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 02/02/2009, 09h27
  4. [MySQL] inserer une ligne d'une table dans une autre table
    Par piero53 dans le forum PHP & Base de données
    Réponses: 5
    Dernier message: 14/12/2008, 18h29
  5. Recherche une valeur d'une cellule dans une colonne d'une autre feuille
    Par kourria dans le forum Macros et VBA Excel
    Réponses: 8
    Dernier message: 21/06/2007, 13h48

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo