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 :

Extraire ligne vers une autre feuille [XL-2010]


Sujet :

Macros et VBA Excel

  1. #1
    Nouveau Candidat au Club
    Homme Profil pro
    Responsable marketing opérationnel
    Inscrit en
    Mars 2015
    Messages
    3
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Canada

    Informations professionnelles :
    Activité : Responsable marketing opérationnel

    Informations forums :
    Inscription : Mars 2015
    Messages : 3
    Points : 1
    Points
    1
    Par défaut Extraire ligne vers une autre feuille
    Bonjour,

    J'ai un petit problem avec mon VBA. J'ai ma formule VBA ici-bas, mais il extrait seulement 2 lignes... Je ne comprends pas! Mes ligne a extraires sont dans la feuille Cotation et son dirigées vers la feuille MYB.

    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
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    Dim ligne As Integer
    Dim controle As String
     
     
    Sub copie()
     
    'Sélection de la feuille Extract
    Sheets("Cotation").Select
    Range("B2").Select
     
    'Vérification du critère de sélection MYB
    Do While ActiveCell.Value <> "" 'Boucle tant qu'on ne tombe pas sur une cellule vide
            If ActiveCell.Value Like "MYB*" Then
     
                ligne = ActiveCell.Row              'on stoke le numéro de ligne
                controle = Cells(ligne, 1).Value    'on stocke le nom du client pour vérification des doublons
     
                'copie de la ligne (colonne A à H)
                Range(Cells(ligne, 1), Cells(ligne, 8)).Copy
                Sheets("MYB").Activate
                Range("B2").Select
     
                'cas numero 1 : aucune ligne n'a déjà été exportée
                If ActiveCell.Offset(1, 0).Value = "" Then
                    ActiveCell.Offset(1, 0).Select
     
                    'controle doublon
                    If Application.WorksheetFunction. _
                        CountIf(Range("B:B"), controle) = 0 Then
     
                        'Pas de doublon : collage de la ligne
                        ActiveSheet.Paste
                        Sheets("Cotation").Select
                        ActiveCell.Offset(1, 0).Select
     
                        'Doublon détecté
                    Else: GoTo doublon:
                    End If
     
                'cas numero 2 : des lignes ont déjà été exportées
                Else
                    Selection.End(xlDown).Select
                    ActiveCell.Offset(1, 0).Select
     
                    'controle doublon
                    If Application.WorksheetFunction. _
                        CountIf(Range("B:B"), controle) = 0 Then
     
                        'Pas de doublon : collage de la ligne
                        ActiveSheet.Paste
                        Sheets("Cotation").Select
                        ActiveCell.Offset(1, 0).Select
     
                    'Doublon détecté
                    Else: GoTo doublon:
                    End If
     
                End If
     
            'pas de MYB dans la cellule
            Else
                ActiveCell.Offset(1, 0).Select
          End If
     
    GoTo boucle:
     
    doublon:
    Sheets("Cotation").Select
    ActiveCell.Offset(1, 0).Select
     
    boucle:
    Loop
     
    End Sub

  2. #2
    Nouveau Candidat au Club
    Homme Profil pro
    Responsable marketing opérationnel
    Inscrit en
    Mars 2015
    Messages
    3
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Canada

    Informations professionnelles :
    Activité : Responsable marketing opérationnel

    Informations forums :
    Inscription : Mars 2015
    Messages : 3
    Points : 1
    Points
    1
    Par défaut
    Voici mon fichier
    Fichiers attachés Fichiers attachés

  3. #3
    Membre éprouvé
    Homme Profil pro
    Programmeur analyste
    Inscrit en
    Février 2009
    Messages
    546
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 52
    Localisation : Canada

    Informations professionnelles :
    Activité : Programmeur analyste
    Secteur : Industrie

    Informations forums :
    Inscription : Février 2009
    Messages : 546
    Points : 1 116
    Points
    1 116
    Par défaut
    Bonjour,

    J'ai modifier seulement ou ça n'allait pas
    mais ce serait à améliorer (Voir commentaire à la fin)
    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
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    Sub copie()
    
    'Sélection de la feuille Extract
    Sheets("Cotation").Select
    Range("B2").Select
      
    'Vérification du critère de sélection MYB
    Do While ActiveCell.Value <> "" 'Boucle tant qu'on ne tombe pas sur une cellule vide
            If ActiveCell.Value Like "MYB*" Then
                
                ligne = ActiveCell.Row              'on stoke le numéro de ligne
                controle = Cells(ligne, 1).Value    'on stocke le nom du client pour vérification des doublons
                
                'copie de la ligne (colonne A à H)
                Range(Cells(ligne, 1), Cells(ligne, 8)).Copy
                Sheets("MYB").Activate
                Range("B2").Select
                
                'cas numero 1 : aucune ligne n'a déjà été exportée
                If ActiveCell.Offset(1, 0).Value = "" Then
                    ActiveCell.Offset(1, 0).Select
                    
                    'controle doublon
                    If Application.WorksheetFunction. _
                        CountIf(Range("B:B"), controle) = 0 Then
                    
                        'Pas de doublon : collage de la ligne
                        ActiveSheet.Paste
                        Sheets("Cotation").Select
                        ActiveCell.Offset(1, 0).Select
                        
                        'Doublon détecté
                    Else: GoTo doublon:
                    End If
                    
                'cas numero 2 : des lignes ont déjà été exportées
                Else
                    '================================================
                    'ici
                    'Selection.End(xlDown + 1).Select
                    'ActiveCell.Offset(1, 0).Select
                    Range("B" & Range("B" & Rows.Count).End(xlUp).Row + 1).Select
                    '================================================
                    
                    'controle doublon
                    If Application.WorksheetFunction. _
                        CountIf(Range("B:B"), controle) = 0 Then
                        
                        'Pas de doublon : collage de la ligne
                        ActiveSheet.Paste
                        Sheets("Cotation").Select
                        ActiveCell.Offset(1, 0).Select
                        
                    'Doublon détecté
                    Else: GoTo doublon:
                    End If
                    
                End If
            
            'pas de MYB dans la cellule
            Else
                ActiveCell.Offset(1, 0).Select
          End If
        
    GoTo boucle:
    
    doublon:
    Sheets("Cotation").Select
    ActiveCell.Offset(1, 0).Select
        
    boucle:
    Loop
       
    End Sub
    Commentaire
    Pour des raisons de performance, il est mieux de ne pas activer les feuilles pour copier et coller
    vaux mieux faire récupérer les valeurs et coller comme
    ex:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    'pour copier
    Sheets("Cotation").Range(Cells(ligne, 1), Cells(ligne, 8)).Copy
    'pour coller
    Sheets("MYB").Range("B" & Range("B" & Rows.Count).End(xlUp).Row + 1).paste
    à toi de voir

  4. #4
    Nouveau Candidat au Club
    Homme Profil pro
    Responsable marketing opérationnel
    Inscrit en
    Mars 2015
    Messages
    3
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Canada

    Informations professionnelles :
    Activité : Responsable marketing opérationnel

    Informations forums :
    Inscription : Mars 2015
    Messages : 3
    Points : 1
    Points
    1
    Par défaut
    Parfait! Merci

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

Discussions similaires

  1. [XL-2013] Copier lignes vers une autre feuille si une cellule = à
    Par antgrandj dans le forum Excel
    Réponses: 10
    Dernier message: 19/06/2014, 19h37
  2. [XL-2007] Excel 2007 Copier Coller une ligne vers une autre feuille
    Par fcjunic dans le forum Macros et VBA Excel
    Réponses: 5
    Dernier message: 04/02/2013, 22h54
  3. Transférer une ligne d'une feuille vers une autre feuille
    Par ElPibeOro dans le forum Macros et VBA Excel
    Réponses: 4
    Dernier message: 23/04/2012, 11h20
  4. Réponses: 3
    Dernier message: 15/11/2011, 15h35
  5. [XL-2007] copier une ligne d'une feuille vers une autre feuille
    Par scarfunk dans le forum Macros et VBA Excel
    Réponses: 7
    Dernier message: 27/05/2010, 23h18

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