[Resolu]recopier partie de donnees de 2 feuilles sur un tableau sous condition

[MikeBelgique]

Bonsoir forum,

2 feuilles de donnees A & B et une troisième feuille relevé sur laquelle un tableau; selon si l'intitulé est repris dans la colonne H des feuille A ET B je souhaiterais qu'il recopie les n°; nom; prénom correspondant aux colonne A B C
des feuilles A &B dans des parties du tableau de la feuille relevé.


Le fichier joint pour meilleure compréhension de mon explication chinoise


En vous remerciant d'avance de l'aide que vous pourrez m'apporter.

 

[MikeBelgique]

Re : recopier partie de donnees de 2 feuilles sur un tableau sous condition

Bon en partant du code fourni par FredOo pour une autre partie de ce fichier j'arrive à un résultat, bien que l'encodage vba n'est certe pas le plus approprié, seul hic si je reclique sur le bouton, mes deux dernière condition sont dupliquée.
Pourriez vous me donner une piste sur le problème.
Merci à vous de l'attention que vous me porterez.

 

[Bebere]

Re : recopier partie de donnees de 2 feuilles sur un tableau sous condition

bonjour MikeBelgique
ton code simplifié

Option Compare Text
Private Sub CommandButton1_Click()

Range("A4:C19,a21:c25,d4:f9,d11:f15,g4:i10,g12:i16").ClearContents

 Dim FeAB As Worksheet, dlf As Integer, c As Range, dlLib As Integer, dlLij As Integer
 nomf = Array("A", "B")
 
 For i = 0 To UBound(nomf)
    Set FeAB = Worksheets(nomf(i))
    dlf = FeAB.[B65536].End(xlUp).Row
    For Each c In FeAB.Range("A2:A" & dlf)
 If c.Offset(, 1) <> vbNullString Then
           Select Case c.Offset(0, 7)
           Case "AVANT"
                dlLib = [A19].End(xlUp).Row + 1
                    Range("A" & dlLib) = c
                    Range("B" & dlLib) = c.Offset(, 1)
                    Range("C" & dlLib) = c.Offset(, 2)
                    
                        Case "APRES"
                dlLib = [D26].End(xlUp).Row + 1
                    Range("D" & dlLib) = c
                    Range("E" & dlLib) = c.Offset(, 1)
                    Range("F" & dlLib) = c.Offset(, 2)
                         
                        Case "Demain"
                dlLib = [G10].End(xlUp).Row + 1
                    Range("G" & dlLib) = c
                    Range("H" & dlLib) = c.Offset(, 1)
                    Range("I" & dlLib) = c.Offset(, 2)
                    
                         Case "aaa"
                dlLib = [G27].End(xlUp).Row + 1
                    Range("G" & dlLib) = c
                    Range("H" & dlLib) = c.Offset(, 1)
                    Range("I" & dlLib) = c.Offset(, 2)
                   
                        Case "bbb"
                dlLib = [D32].End(xlUp).Row + 1
                    Range("D" & dlLib) = c
                    Range("E" & dlLib) = c.Offset(, 1)
                    Range("F" & dlLib) = c.Offset(, 2)
                    
                        Case "ccc"
                dlLib = [G22].End(xlUp).Row + 1
                    Range("G" & dlLib) = c
                    Range("H" & dlLib) = c.Offset(, 1)
                    Range("I" & dlLib) = c.Offset(, 2)
                    
            End Select
        End If
    Next c
Next i
    Columns("A:I").AutoFit

End Sub

edit:ajout de option compare text

 

[MikeBelgique]

Re : recopier partie de donnees de 2 feuilles sur un tableau sous condition

Bonsoir Bebere, désolé de te répondre si tard, mais étant de service de nuit je viens juste de tester au boulot ta proposition qui marche nickel et qui est plus simple que celle dans laquelle je m'était lancé d'établir à défaut de vos connaissances dans le domaine. Grand merci pour ton aide.

Pour ce qui est du problème de duplication, erreur de ma part; la ligne :

Range("A4:C19,a21:c25,d4:f9,d11:f15,g4:i10,g12:i16").ClearContents n'était pas complète et donc toutes les cases voulues non vidées de leur contenu.
fichier corrigé et joint pour finalité

 

[Bebere]

Re : [Resolu]recopier partie de donnees de 2 feuilles sur un tableau sous condition

bonjour MikeBelgique
fait autrement pour te montrer les possibilités
il est intéressant de déclarer les variables avec majuscule
lors de l'écriture du code tu écris les variables en minuscule et si pas de fautes les majuscules apparaissent

Option Explicit
Option Compare Text

Private Sub CommandButton1_Click()
    Range("b3:h22, j3:p22").ClearContents

    Dim Dlf As Long, L As Long, i As Byte, c As Byte, NomF As Variant, Tbl As Variant
    NomF = Array("A", "B")

    For i = 0 To UBound(NomF)
        With Worksheets(NomF(i))
            Dlf = .[B65536].End(xlUp).Row
           Tbl = .Range("B2:F" & Dlf)
        End With

        For L = 1 To UBound(Tbl, 1)
            If Tbl(L, 1) <> vbNullString Then
                If Tbl(L, 5) = "OUI" Then 'pass
        If NomF(i) = "A" Then c = 2 Else c = 10
                    Dlf = Cells(65536, c).End(xlUp).Row + 1
                    Cells(Dlf, c) = Tbl(L, 1) 'nom
                    Cells(Dlf, c + 1) = Tbl(L, 2) 'prénom
                    Cells(Dlf, c + 2) = Tbl(L, 4) 'entrée
                    End If
                End If
            
        Next L
    Next i
End Sub

 

[MikeBelgique]

Re : [Resolu]recopier partie de donnees de 2 feuilles sur un tableau sous condition

Merci Bebere de ta participation, toutefois je suis en congé une semaine à partir de ce matin, je ne pourrai pas testé ceci avant ma reprise car chez moi je dispose de 2010, et actuellement mes demandes concernent des fichiers sous 2003 (du moins encore quelques mois avant la migration vers 2010) et pour des besoins professionnel, je te tiendrai au courant dès que possible.
Encore mille merci.

 

[MikeBelgique]

Re : [Resolu]recopier partie de donnees de 2 feuilles sur un tableau sous condition

Bonsoir tout le monde, comme promis Bebere je reviens vers toi.

Malheureusement j'ai testé ta deuxième solution et je me suis heurté à une impossibilité de fonctionnement, le premier problème est une erreur 1004 impossible de modifier une cellule fusionnée. Bien sûr lorsque je remet les cellules non fusionnées c'est la catastrophe. Toutefois ta première solution est fonctionnelle et donc pas de soucis. A toi de voir si tu veux consacré du temps à ce problème facultatif. Encore merci pour ta précieuse aide.