XL 2016 Code Transfer suivant condition

Seddiki_adz

XLDnaute Impliqué
bonjour
pour transférer en fonction de la colonne T , les colonnes: F, G,M,O,P,L de la basse feuil1 vers les colonnes B,C,D,E,F,G par cette ordre
j'ai besoin d'aide pour rectifier ce code
Merci
 

Pièces jointes

  • recep.xls
    81.5 KB · Affichages: 12
Solution
Re,
Voici un exemple de ce que l'on peut faire.
J'ai transformé tes listes en Feuil1 et Feuil2 en tableaux structurés.
J'ai géré l'événement BeforeDoubleClick de la Feuil1 de telle sorte que, si l'on fait un double clic dans la colonne T (ou 20), les cellules F, G, M, O, P ,L des lignes qui ont le même code en T soient transférées vers la Feuil2.
Voilà le code :
Enrichi (BBcode):
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim Critère As String, TbRes(), tb, moins As Byte, i As Long, j As Long
    If Not Intersect(Target, Me.[tb_Source[20]]) Is Nothing Then
        Critère = Intersect(Target, Me.[tb_Source[20]]).Value
        tb = Me.[tb_Source]
        j = 0
        For i = 1 To UBound(tb)
            If...

AtTheOne

XLDnaute Impliqué
Supporter XLD
Bonsoir à toutes et à tous, bonsoir @Seddiki_adz
  1. Est-ce-que la Feuil1 est bien la feuille source
  2. Est-ce-que la Feuil2 est bien la feuille cible
  3. Est-ce qu'il faut demander le critère à l'utilisateur (Ici la seule valeur est CEM2) ou peut-on faire la sélection par un double clic sur une cellule du tableau puis utiliser la valeur de la colonne T comme critère ?
Amicalement
Alain
 

Seddiki_adz

XLDnaute Impliqué
Bonsoir à toutes et à tous, bonsoir @Seddiki_adz
  1. Est-ce-que la Feuil1 est bien la feuille source
  2. Est-ce-que la Feuil2 est bien la feuille cible
  3. Est-ce qu'il faut demander le critère à l'utilisateur (Ici la seule valeur est CEM2) ou peut-on faire la sélection par un double clic sur une cellule du tableau puis utiliser la valeur de la colonne T comme critère ?
Amicalement
Alain
Bonjour
Bonne retour
oui
la Feuil1 est bien la feuille source
la Feuil2 est bien la feuille cible
le critère la colonne T
 

AtTheOne

XLDnaute Impliqué
Supporter XLD
Re,
Voici un exemple de ce que l'on peut faire.
J'ai transformé tes listes en Feuil1 et Feuil2 en tableaux structurés.
J'ai géré l'événement BeforeDoubleClick de la Feuil1 de telle sorte que, si l'on fait un double clic dans la colonne T (ou 20), les cellules F, G, M, O, P ,L des lignes qui ont le même code en T soient transférées vers la Feuil2.
Voilà le code :
Enrichi (BBcode):
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim Critère As String, TbRes(), tb, moins As Byte, i As Long, j As Long
    If Not Intersect(Target, Me.[tb_Source[20]]) Is Nothing Then
        Critère = Intersect(Target, Me.[tb_Source[20]]).Value
        tb = Me.[tb_Source]
        j = 0
        For i = 1 To UBound(tb)
            If tb(i, 20) = Critère Then
                j = j + 1: ReDim Preserve TbRes(1 To 6, 1 To j)
                TbRes(1, j) = tb(i, 6): TbRes(2, j) = tb(i, 7): TbRes(3, j) = tb(i, 13): TbRes(4, j) = tb(i, 15): TbRes(5, j) = tb(i, 16): TbRes(6, j) = tb(i, 12)
            End If
        Next i
        If j > 0 Then
            With Feuil2.[tb_Cible]
                moins = 0
                If WorksheetFunction.CountA(.Rows(1)) = 1 Then moins = 1
                .Offset(.Rows.Count - moins, 1).Resize(j, 6).Value = Application.Transpose(TbRes)
            End With
            Cancel = True
            MsgBox j & " ligne(s) transférée(s)"
        End If
    End If
End Sub

Voir PJ
Amicalement
Alain
 

Pièces jointes

  • Code Transfer suivant condition.xlsm
    29.3 KB · Affichages: 3

Seddiki_adz

XLDnaute Impliqué
Re,
Voici un exemple de ce que l'on peut faire.
J'ai transformé tes listes en Feuil1 et Feuil2 en tableaux structurés.
J'ai géré l'événement BeforeDoubleClick de la Feuil1 de telle sorte que, si l'on fait un double clic dans la colonne T (ou 20), les cellules F, G, M, O, P ,L des lignes qui ont le même code en T soient transférées vers la Feuil2.
Voilà le code :
Enrichi (BBcode):
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim Critère As String, TbRes(), tb, moins As Byte, i As Long, j As Long
    If Not Intersect(Target, Me.[tb_Source[20]]) Is Nothing Then
        Critère = Intersect(Target, Me.[tb_Source[20]]).Value
        tb = Me.[tb_Source]
        j = 0
        For i = 1 To UBound(tb)
            If tb(i, 20) = Critère Then
                j = j + 1: ReDim Preserve TbRes(1 To 6, 1 To j)
                TbRes(1, j) = tb(i, 6): TbRes(2, j) = tb(i, 7): TbRes(3, j) = tb(i, 13): TbRes(4, j) = tb(i, 15): TbRes(5, j) = tb(i, 16): TbRes(6, j) = tb(i, 12)
            End If
        Next i
        If j > 0 Then
            With Feuil2.[tb_Cible]
                moins = 0
                If WorksheetFunction.CountA(.Rows(1)) = 1 Then moins = 1
                .Offset(.Rows.Count - moins, 1).Resize(j, 6).Value = Application.Transpose(TbRes)
            End With
            Cancel = True
            MsgBox j & " ligne(s) transférée(s)"
        End If
    End If
End Sub

Voir PJ
Amicalement
Alain
Super
mon dieu merci
mes sollicitation
 

Discussions similaires

Réponses
4
Affichages
447