Transferer quelques lignes d'une feuille dans une autre feuille en comparant deux col

[tigeline001]

Bonjour tout le monde
j'ai un classeur de 3 feuilles (REC_DIS,Liste_Service,Transfere) .
-Dans REC_DIS j'ai un tableau portant le nom , le prenom et le domaine d'un inspecteur
Dans Liste_Service j'ai un tableau portant la liste des inspecteur pas Direction
je veux comparer et rechercher le nom et le prenom de chaque inspecteur se trouvant dans REC_DIS avec les inspecteurs de la colonne"Sécurité_Saint_Louis" de la feuille Liste_Service
Si on trouve on copie le nom , le prenom et domaine correspondant dans la feuille "Transfere"
j'ai essayé de le faire en utilisant le code suivant mais ca me retourne une page vide
Merci
Private Sub Worksheet_Activate()
Dim sh1, c As Range, aa, i&, a&, fin&, lig&
Dim sh2, p As Range
Dim inspFound As Range
Dim inspecteur As String
'recupere linspecteur dans REC_DIS
inspecteur = ThisWorkbook.Worksheets("REC_DIS").Range("A1" & "B1")

'recherche l existence dans liste service
Set inspFound = Worksheets("Liste_Service").Range("B1").Find(inspecteur, LookIn:=xlValues, LookAt:=xlWhole)

fin = Feuil1.Range("D" & Rows.Count).End(xlUp).Row
If fin < 5 Then Exit Sub
lig = 2
With Feuil3
.Cells.Clear: .Cells(1, 1) = "Nom_inspecteur": .Cells(1, 2) = "Prenom_inspecteur": .Cells(1, 3) = "Domaine"
.Rows(1).Font.Bold = True
For i = 5 To fin
If inspFound Then
.Cells(lig, 1) = Feuil1.Cells(i, 1): .Cells(lig, 2) = Feuil2.Cells(i, 2): .Cells(lig, 3) = Feuil3.Cells(i, 3)
lig = lig + 1
End If
Next i
.Columns("A").AutoFit: .Range("A1").CurrentRegion.Borders.LineStyle = 1
End With
End Sub

 

[CPk]

Re : Transferer quelques lignes d'une feuille dans une autre feuille en comparant deu

Bonsoir, il y a des erreurs ici et là alors j'ai préféré refaire le code en tentant de l'expliquer.
Dites moi si cela vous convient et ce que vous ne comprenez pas dans le code et/ou les explications

 

[tigeline001]

Re : Transferer quelques lignes d'une feuille dans une autre feuille en comparant deu

Merci CPk
C'est ce que voulais.Merci encore tes explications sont très claires

 

[CPk]

Re : Transferer quelques lignes d'une feuille dans une autre feuille en comparant deu

Salutations

 

[tigeline001]

Re : Transferer quelques lignes d'une feuille dans une autre feuille en comparant deu

Bonjour CPk
j'ai un petit problème quand j'ajoute une colonne date à la feuille REC_DIS pour la recuperation dans la feuille Transfere la colonne date
affiche seulement l'heure en plus de cela j'ai essaye d'ajouter le titre des colonnes mais rien
Merci

 

[CPk]

Re : Transferer quelques lignes d'une feuille dans une autre feuille en comparant deu

Bonjour tigeline , voici la MAJ de la macro

Sub transfert()
    Dim trouve As Range, quoi$
Feuil3.Cells.Delete 'j'efface la feuille transfere

    With Feuil1    'Déclaration implicite de l'objet feuil1
        For i = 2 To .UsedRange.Rows.Count    'traitement de la ligne 2 à la dernière ligne non vide
            Z = .Cells(i, 1) & Chr(32) & .Cells(i, 2)    'dans la variable z j'écris le nom et prénom séparé par un espace
            Set trouve = Feuil2.Columns(2).Find(Z, lookat:=xlWhole)    'j'indique de rechercher la valeur de z dans la colonne 2
            If Not trouve Is Nothing Then    'si un résultat est trouvé
                Feuil3.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 4) = .Cells(i, 1).Resize(1, 4).Value    'sur ma feuil3 je rajoute à chaque nouvelle ligne vide le contenu des trois colonnes (a b c) de la ligne i
            End If    'fin de ma condition
        Next i    'je cherche la ligne suivante de la feuil1 et je répète jusqu'à la dernière ligne non vide
        'une fois la boucle terminée
    End With    'je cloture la déclaration implicite
With Feuil3
.Activate
'.UsedRange.RemoveDuplicates Array(1, 4), xlNo   'je supprime les doublons s'il y en a
.Cells(1, 1).Resize(1, 4) = Feuil1.Cells(1, 1).Resize(1, 4).Value 'Rajout des entêtes
.Columns("A:C").AutoFit 'J'ajuste mes colonnes en tailles
.Columns(4).NumberFormat = "dd/mm/yyyy hh:mm" 'Formater la colonne pour afficher un format de date
End With

End Sub

J'ai rajouté

.Cells(1, 1).Resize(1, 4) = Feuil1.Cells(1, 1).Resize(1, 4).Value 'Rajout des entêtes

.Columns(4).NumberFormat = "dd/mm/yyyy hh:mm" 'Formater la colonne pour afficher un format de date

 

[tigeline001]

Re : Transferer quelques lignes d'une feuille dans une autre feuille en comparant deu

Merci CPk
j'ai trouvé la solution
Merci pour ton aide

 

[tigeline001]

Re : Transferer quelques lignes d'une feuille dans une autre feuille en comparant deu

En fait j'ai utilisé une partie de ton code et je l'ai adapté au mien
Private Sub Worksheet_Activate()
Dim trouve As Range, quoi$
Feuil54.Cells.Delete 'j'efface la feuille transfere

With Feuil50 'Déclaration implicite de l'objet feuil1
lig = 2
Feuil54.Cells(1, 1) = "Intervention": Feuil54.Cells(1, 2) = "Conclusion": Feuil54.Cells(1, 3) = "Code": Feuil54.Cells(1, 4) = "Genre_Intervention": Feuil54.Cells(1, 5) = "Statut": Feuil54.Cells(1, 6) = "Date_début": Feuil54.Cells(1, 7) = "Date_fin": Feuil54.Cells(1, 8) = "Code_Inspecteur": Feuil54.Cells(1, 9) = "Anomalie": Feuil54.Cells(1, 10) = "Numero_demande": Feuil54.Cells(1, 11) = "Date_Creation_Demande": Feuil54.Cells(1, 12) = "Nom_Inspecteur": Feuil54.Cells(1, 13) = "Prenom_Inspecteur": Feuil54.Cells(1, 14) = "Domaine_Intervention"
Feuil54.Rows(1).Font.Bold = True
For i = 2 To .UsedRange.Rows.Count 'traitement de la ligne 2 à la dernière ligne non vide
Z = .Cells(i, 12) & Chr(32) & .Cells(i, 13) 'dans la variable z j'écris le nom et prénom séparé par un espace
Set trouve = Feuil53.Columns(3).Find(Z, lookat:=xlWhole) 'j'indique de rechercher la valeur de z dans la colonne 2
If Not trouve Is Nothing Then 'si un résultat est trouvé
'Feuil54.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 14) = .Cells(i, 1).Resize(1, 14).Value 'sur ma feuil3 je rajoute à chaque nouvelle ligne vide le contenu des trois colonnes (a b c) de la ligne i
Feuil54.Cells(lig, 1) = Feuil50.Cells(i, 1): Feuil54.Cells(lig, 2) = Feuil50.Cells(i, 2): Feuil54.Cells(lig, 3) = Feuil50.Cells(i, 3): Feuil54.Cells(lig, 4) = Feuil50.Cells(i, 4): Feuil54.Cells(lig, 5) = Feuil50.Cells(i, 5): Feuil54.Cells(lig, 6) = Feuil50.Cells(i, 6): Feuil54.Cells(lig, 7) = Feuil50.Cells(i, 7): Feuil54.Cells(lig, 8) = Feuil50.Cells(i, 8): Feuil54.Cells(lig, 9) = Feuil50.Cells(i, 9): Feuil54.Cells(lig, 10) = Feuil50.Cells(i, 10): Feuil54.Cells(lig, 11) = Feuil50.Cells(i, 11): Feuil54.Cells(lig, 12) = Feuil50.Cells(i, 12): Feuil54.Cells(lig, 13) = Feuil50.Cells(i, 13): Feuil54.Cells(lig, 14) = Feuil50.Cells(i, 14)
lig = lig + 1
End If 'fin de ma condition
Next i 'je cherche la ligne suivante de la feuil1 et je répète jusqu'à la dernière ligne non vide
'une fois la boucle terminée
End With 'je cloture la déclaration implicite
With Feuil54
.Activate
'.UsedRange.RemoveDuplicates Array(1, 3), xlNo 'je supprime les doublons s'il y en a
.Columns("A:Y").AutoFit: .Range("A1").CurrentRegion.Borders.LineStyle = 1 'J'ajuste mes colonnes en tailles
End With

End Sub

 

[CPk]

Re : Transferer quelques lignes d'une feuille dans une autre feuille en comparant deu

Maintenant que vous avez construit votre code, a tête reposée, il faudra songer à le réduire pour que vous ne vous cassiez plus trop la tête (à l'avenir) à écrire et re écrire 27 fois les mêmes mots. Par exemple :

Feuil1.Cells(1, 1).Resize(1, 3) = Array("Test 1", "Test 2", "test 3")

C'est similaire à

feuil1.cells(1,1) = "Test 1" :feuil1.cells(1,2) = "Test 2":feuil1.cells(1,3) = "Test 3"

Sauf que Feuil1.cells(x,x) on ne l'écrit qu'une seule fois et nul besoin d'attraper des douleurs tandinitoïdes à force de copier-coller mainte et mainte fois feuil1.cells(1,1) puis de changer les coordonnés.

Si vous tentez l'aventure, n'hésitez pas à revenir vers nous ! Je vous invite à le faire comme ça votre code sera aéré et vous y verrez plus clair dans ce que vous écrierai

 

[CPk]

Re : Transferer quelques lignes d'une feuille dans une autre feuille en comparant deu

Cette grosse partie là :

Feuil54.Cells(lig, 1) = Feuil50.Cells(i, 1): Feuil54.Cells(lig, 2) =  Feuil50.Cells(i, 2): Feuil54.Cells(lig, 3) = Feuil50.Cells(i, 3):  Feuil54.Cells(lig, 4) = Feuil50.Cells(i, 4): Feuil54.Cells(lig, 5) =  Feuil50.Cells(i, 5): Feuil54.Cells(lig, 6) = Feuil50.Cells(i, 6):  Feuil54.Cells(lig, 7) = Feuil50.Cells(i, 7): Feuil54.Cells(lig, 8) =  Feuil50.Cells(i, 8): Feuil54.Cells(lig, 9) = Feuil50.Cells(i, 9):  Feuil54.Cells(lig, 10) = Feuil50.Cells(i, 10): Feuil54.Cells(lig, 11) =  Feuil50.Cells(i, 11): Feuil54.Cells(lig, 12) = Feuil50.Cells(i, 12):  Feuil54.Cells(lig, 13) = Feuil50.Cells(i, 13): Feuil54.Cells(lig, 14) =  Feuil50.Cells(i, 14)

A priori à chaque fois de chaque côté du = on incrémente le n° de colonne de 1 donc vous pouvez l'optimiser

 

[tigeline001]

Re : Transferer quelques lignes d'une feuille dans une autre feuille en comparant deu

Merci Cpk
c fait
Es ce je peux t'envoyer un message si j'ai d'autres problemes en vba

 

[CPk]

Re : Transferer quelques lignes d'une feuille dans une autre feuille en comparant deu

Pas par message privé. Il faut ouvrir un nouveau sujet en expliquant la problématique. Comme ça tout ceux qui peuvent aider aideront. Et puis rappelez-vous qu'il n'y a pas de sous-question ni de gens plus intelligent que d'autre, il n'y a simplement que des sympathisants qui partagent un savoir faire sur excel et vba

 

[tigeline001]

Re : Transferer quelques lignes d'une feuille dans une autre feuille en comparant deu

Merci encore PCk

 

[CPk]

Re : Transferer quelques lignes d'une feuille dans une autre feuille en comparant deu

remerciement partagé.