VBA copie de ligne

Bonjour à tous,

Je débute en VBA et je coince sur la création d'une fonction permettant de copier les informations (B:D) de la ligne, sur l'onglet "Combattant" de (B:D), sous la condition que sur la ligne, dans la colonne "M" il y est "1".

J'aimerai coupler cela, si possible, avec la copie dans l'onglet "Anciens Membres" puis la suppression de la ligne dans l'onglet "Informations Membres" si il y a un "1" présent dans la colonne "S"

Je pensais pouvoir m'en sortir étant donner que je maitrise l'automatisme mais dans la réalité c'est complétement différent.

Pouvais vous me donner un coup de main svp ?

Je vous laisse mon fichier excel ainsi qu'un récapitulatif visuel sous Word. Il se peut qu'en voyant le code je comprenne mieux la logique.

Merci d'avance

Bonsoir RoadCrow, bonsoir le forum,

Une proposition Full Comment ci-dessous :

Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim L As Byte 'déclare la variable L (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

Set OS = Worksheets("Informations Membres") 'définit l'onglet source OS
Set OD = Worksheets("Combattants") 'définit l'onglet destination OD

'est-ce qu'il faut effacer au préalable les anciennes données de l'onglet OD ?
'si non met une apostrophe devant les deux lignes en-dessous
DL = OD.Cells(Application.Rows.Count, "B").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne B de l'onglet OD
OD.Range("B14:AE" & DL).ClearContents 'efface les anciennes valeurs de l'onglet OD

DL = OS.Cells(Application.Rows.Count, "B").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne B de l'onglet OS
TV = OS.Range("B14:S" & DL) 'définit le tableau de valeurs TV
For I = 1 To UBound(TV, 1) 'boucle 1 : sur toutes les ligne I du tableau des valeurs
    If TV(I, 13) = 1 Then 'condition : si la donnée ligne I colonne 13 (=> colonne M) de TV est égale à 1
        K = K + 1 'incrémente K
        ReDim Preserve TL(1 To 3, 1 To K) 'redimensionne le tableau des lignes TL (3 lignes . K colonnes)
        For L = 1 To 3 'boucle 2 : sur 3 colonnes (B à D)
            TL(L, K) = TV(I, L) 'récupère dans la ligne L de TL, la donnée en colonne L de TV (=> transposition)
        Next L 'prochaine ligne de la boucle 2
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle
'si K est supérieure à zéro, renvoie le tableau TL transposé dans la cellule B14 redimensionnée de l'onglet OD
If K > 0 Then OD.Range("B14").Resize(K, 3).Value = Application.Transpose(TL)
End Sub

Bonjour ThauThème,

Je te remercie pour ta réponse (surtout les réponses en vert, ca m'a permis de comprendre un peu plus la logique).

J'ai cherché ou il pouvait y avoir une modification à faire dans le VBA parce que toutes les personnes qui ont un "1" dans la colonne "M" ne se mettent pas dans le OD et certaines personnes qui n'ont pas de "1" y apparaissent.

Et ce que je ne comprend pas, c'est que lors du rajout d'un "1" dans la colonne "M" de l'OS il n'y pas de modification instantanée dans le OD.

Bonjour RoadCrow, bonjour le forum,

Il y avait en effet une erreur dans mon code car comme ton tableau commence à la colonne B Il fallait dire : If TV(I, 12) = 1 à la place de If TV(I, 13) = 1.

Pour une modification instantanée, il faudra l'événementielle Change ci-dessous à placer dans le composant Feuil1 (Informations Membres) :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim OD As Worksheet
Dim LI As Integer

If Target.Column <> 13 Then Exit Sub
If Target.Value = 1 Then
    Set OD = Worksheets("Combattants")
    LI = OD.Cells(Application.Rows.Count, "B").End(xlUp).Row + 1
    Cells(Target.Row, "B").Resize(1, 3).Copy OD.Cells(LI, "B")
End If
End Sub

Alors soit tu supprimes la Macro1 et tu n'utilises que celle-ci mais il te faudra repasser un par un tes vikings en mettant 1 dans la colonne M, soit tu lances d'abord la Macro1 (corrigée) pour repartir à zéro et avoir d'un d'un coup tous les Vikongs dans l'onglet Combattants et ensuite l'événementielle Change agira automatiquement.

Mais surtout, et malheureusement je ne m'en aperçois que maintenant, SUPPRIME LES FICHIERS EN PIÈCES JOINTE qui contiennent des données scandaleusement personnelles que tu as laissées sans vergogne. Je suis obligé de te signaler au modérateur de ce site qui risque gros en publiant un tel fichier. Tu aurais pu prendre la peine d'anonymiser ton fichier. Excel fait ça en 30 secondes !...

Salut à toi,

Merci beaucoup ca fonctionne comme il faut.

Effectivement je n'y avais pas penser, tu fais bien de me le faire remarquer.

PS: Si tu donne des cours, je suis preneur ;)

Encore merci

Alors j'ai voulu ajouter une condition supplémentaire en suivant la logique grâce à tes explications, mais ca ne fonctionne pas

Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim P As Integer 'déclare la variable K (incrément)
Dim L As Byte 'déclare la variable L (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

Set OS = Worksheets("Informations Membres") 'définit l'onglet source OS
Set OD = Worksheets("Combattants") 'définit l'onglet destination OD

'est-ce qu'il faut effacer au préalable les anciennes données de l'onglet OD ?
'si non met une apostrophe devant les deux lignes en-dessous
DL = OD.Cells(Application.Rows.Count, "B").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne B de l'onglet OD
OD.Range("B14:AE" & DL).ClearContents 'efface les anciennes valeurs de l'onglet OD

DL = OS.Cells(Application.Rows.Count, "B").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne B de l'onglet OS
TV = OS.Range("B13:S" & DL) 'définit le tableau de valeurs TV
For I = 1 To UBound(TV, 1) 'boucle 1 : sur toutes les ligne I du tableau des valeurs
    If TV(I, 12) = 1 Then 'condition : si la donnée ligne I colonne 13 (=> colonne M) de TV est égale à 1
        K = K + 1 'incrémente K
        ReDim Preserve TL(1 To 3, 1 To K) 'redimensionne le tableau des lignes TL (3 lignes . K colonnes)
        For L = 1 To 3 'boucle 2 : sur 3 colonnes (B à D)
            TL(L, K) = TV(I, L) 'récupère dans la ligne L de TL, la donnée en colonne L de TV (=> transposition)
        Next L 'prochaine ligne de la boucle 2
    End If 'fin de la condition

Next

For P = 1 To UBound(TV, 1)
    If TV(P, 13) = 1 Then
        K = K + 1
        ReDim Preserve TL(1 To 3, 1 To K)
        For L = 1 To 3

        Next L
    End If
Next P

If K > 0 Then OD.Range("B14").Resize(K, 3).Value = Application.Transpose(TL)

End Sub

Malheuresment la deuxième condition qui veux que lorsque il y a "1" dans la colonne N recopier exactement pareil qu'avant mais au lieu de B:D mais de F:H

Bonjour le fil, bonjour le forum,

Sans le fichier je ne me souviens plus bien (mais surtout ne remet plus un fichier non anonymisé ! )

peut-être comme ça :

Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim K1 As Integer 'déclare la variable K1 (incrément)
Dim K2 As Integer 'déclare la variable K2 (incrément)
Dim L As Byte 'déclare la variable L (incrément)
Dim TL1() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim TL2() As Variant 'déclare la variable TL (Tableau des Lignes)

Set OS = Worksheets("Informations Membres") 'définit l'onglet source OS
Set OD = Worksheets("Combattants") 'définit l'onglet destination OD

'est-ce qu'il faut effacer au préalable les anciennes données de l'onglet OD ?
'si non met une apostrophe devant les deux lignes en-dessous
DL = OD.Cells(Application.Rows.Count, "B").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne B de l'onglet OD
OD.Range("B14:AE" & DL).ClearContents 'efface les anciennes valeurs de l'onglet OD

DL = OS.Cells(Application.Rows.Count, "B").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne B de l'onglet OS
TV = OS.Range("B14:S" & DL) 'définit le tableau de valeurs TV
For I = 1 To UBound(TV, 1) 'boucle 1 : sur toutes les ligne I du tableau des valeurs
    If TV(I, 12) = 1 Then 'condition : si la donnée ligne I colonne 12 (=> colonne M) de TV est égale à 1
        K1 = K1 + 1 'incrémente K1
        ReDim Preserve TL1(1 To 3, 1 To K1) 'redimensionne le tableau des lignes TL (3 lignes . K colonnes)
        TL1(1, K1) = TV(I, 1) 'récupère dans la ligne L de TL, la donnée en colonne L de TV (=> transposition)
        TL1(2, K1) = TV(I, 2) 'récupère dans la ligne L de TL, la donnée en colonne L de TV (=> transposition)
        TL1(3, K1) = TV(I, 3) 'récupère dans la ligne L de TL, la donnée en colonne L de TV (=> transposition)
    End If
    If TV(I, 13) = 1 Then 'condition : si la donnée ligne I colonne 13 (=> colonne N) de TV est égale à 1
        K2 = K2 + 1 'incrémente K2
        ReDim Preserve TL2(1 To 3, 1 To K2) 'redimensionne le tableau des lignes TL (3 lignes . K colonnes)
        TL2(1, K2) = TV(I, 4) 'récupère dans la ligne L de TL, la donnée en colonne L de TV (=> transposition)
        TL2(2, K2) = TV(I, 5) 'récupère dans la ligne L de TL, la donnée en colonne L de TV (=> transposition)
        TL2(3, K2) = TV(I, 6) 'récupère dans la ligne L de TL, la donnée en colonne L de TV (=> transposition)
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle
'si K1 est supérieure à zéro, renvoie le tableau TL transposé dans la cellule B14 redimensionnée de l'onglet OD
If K1 > 0 Then OD.Range("B14").Resize(K1, 3).Value = Application.Transpose(TL1)
If K2 > 0 Then OD.Range("F14").Resize(K2, 3).Value = Application.Transpose(TL2)
End Sub

Hello,

Merci beaucoup pour tes réponses.

J'ai apporté quelques modif pour que les cases copier correspondent et ca fonctionne. Par contre lorsque je rajoute des 1 dans les colonne M ou N de l'OS, ca ne rajoute pas les ligne dans l'OD. Ca bloque à la ligne 52. J'avais rajouter dans la Feuille 1 le code suivant comme tu me l'avais conseillé pour un gestion en automatique (ajout de ligne ou suppression en fonction de l'évolution du tableau dans l'OS:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim OD As Worksheet
Dim LI As Integer

If Target.Column <> 13 Then Exit Sub
If Target.Value = 1 Then
    Set OD = Worksheets("Combattants")
    LI = OD.Cells(Application.Rows.Count, "B").End(xlUp).Row + 1
    Cells(Target.Row, "B").Resize(1, 3).Copy OD.Cells(LI, "B")
End If
End Sub

Je remet le fichier sans les infos senssibles. J'ai pas pu le faire via XLSTAT mais c'est anonyme:

Bonjour RoadCrow, bonjour le forum,

je t'avoue que je suis perdu là. Tu me dis que tu as apporté des modifications mais sans me préciser lesquelles !?...

Le code de l'événementielle Change fonctionne normalement pour la colonne M mais pas pour la colonne N.

Dis-moi précisément quel est le problème et sur quel code et j'essaierai de le résoudre...

Salut THAUTHEME,

Alors dans la modification que j'ai apporté il y a rien de bien méchant. C'est juste les lignes à copier de l'OS pour copier les bonnes cellules vers le OD.

ub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim K1 As Integer 'déclare la variable K1 (incrément)
Dim K2 As Integer 'déclare la variable K2 (incrément)
Dim L As Byte 'déclare la variable L (incrément)
Dim TL1() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim TL2() As Variant 'déclare la variable TL (Tableau des Lignes)

Set OS = Worksheets("Informations Membres") 'définit l'onglet source OS
Set OD = Worksheets("Combattants") 'définit l'onglet destination OD

'est-ce qu'il faut effacer au préalable les anciennes données de l'onglet OD ?
'si non met une apostrophe devant les deux lignes en-dessous
DL = OD.Cells(Application.Rows.Count, "B").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne B de l'onglet OD
OD.Range("B14:AE" & DL).ClearContents 'efface les anciennes valeurs de l'onglet OD

DL = OS.Cells(Application.Rows.Count, "B").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne B de l'onglet OS
TV = OS.Range("B14:S" & DL) 'définit le tableau de valeurs TV
For I = 1 To UBound(TV, 1) 'boucle 1 : sur toutes les ligne I du tableau des valeurs
    If TV(I, 12) = 1 Then 'condition : si la donnée ligne I colonne 12 (=> colonne M) de TV est égale à 1
        K1 = K1 + 1 'incrémente K1
        ReDim Preserve TL1(1 To 3, 1 To K1) 'redimensionne le tableau des lignes TL (3 lignes . K colonnes)
        TL1(1, K1) = TV(I, 1) 'récupère dans la ligne L de TL, la donnée en colonne L de TV (=> transposition)
        TL1(2, K1) = TV(I, 2) 'récupère dans la ligne L de TL, la donnée en colonne L de TV (=> transposition)
        TL1(3, K1) = TV(I, 3) 'récupère dans la ligne L de TL, la donnée en colonne L de TV (=> transposition)
    End If
    If TV(I, 13) = 1 Then 'condition : si la donnée ligne I colonne 13 (=> colonne N) de TV est égale à 1
        K2 = K2 + 1 'incrémente K2
        ReDim Preserve TL2(1 To 3, 1 To K2) 'redimensionne le tableau des lignes TL (3 lignes . K colonnes)
        TL2(1, K2) = TV(I, 1) 'récupère dans la ligne L de TL, la donnée en colonne L de TV (=> transposition)
        TL2(2, K2) = TV(I, 2) 'récupère dans la ligne L de TL, la donnée en colonne L de TV (=> transposition)
        TL2(3, K2) = TV(I, 3) 'récupère dans la ligne L de TL, la donnée en colonne L de TV (=> transposition)
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle
'si K1 est supérieure à zéro, renvoie le tableau TL transposé dans la cellule B14 redimensionnée de l'onglet OD
If K1 > 0 Then OD.Range("B14").Resize(K1, 3).Value = Application.Transpose(TL1)
If K2 > 0 Then OD.Range("G14").Resize(K2, 3).Value = Application.Transpose(TL2)
End Sub

Ma problématique c'est que lorsque je rajoute un "1" dans la colonne M ou dans la colonne N de l'OS, après la ligne 51 ou 52, ca ne copie pas les lignes dans l'OD même quand je relance le Module1. A la suite de ca, lorsque je rajoute des des "1" dans la colonne M ou N, une fois le module lancer, ca ne rajoute pas automatiquement les lignes vers l'OD, ni ne les supprime lorsque j'enlèves un "1" dans l'OS