Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

Créer une discussion

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
T

tigeline001

XLDnaute Occasionnel
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
 

Pièces jointes

Trier par date Trier par votes
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
 

Pièces jointes

Vote positif 0 Vote négatif
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
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Transferer quelques lignes d'une feuille dans une autre feuille en comparant deu

Bonjour tigeline , voici la MAJ de la macro


Code: 
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é
Code: 
.Cells(1, 1).Resize(1, 4) = Feuil1.Cells(1, 1).Resize(1, 4).Value 'Rajout des entêtes

Code: 
.Columns(4).NumberFormat = "dd/mm/yyyy hh:mm" 'Formater la colonne pour afficher un format de date
 
Vote positif 0 Vote négatif
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
 
Vote positif 0 Vote négatif
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 :
Code: 
Feuil1.Cells(1, 1).Resize(1, 3) = Array("Test 1", "Test 2", "test 3")
C'est similaire à
Code: 
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 🙂
 
Vote positif 0 Vote négatif
Re : Transferer quelques lignes d'une feuille dans une autre feuille en comparant deu

Cette grosse partie là :

Code: 
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
 
Vote positif 0 Vote négatif
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
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

A
  • Résolu(e)
XL 2016 Recherche d'un mot dans une cellule et surlignage de la ligne
Réponses
4
Affichages
97
Abi23
A
  • Question Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
1 K
Nicolas JACQUIN
  • Question Question
XL 2019 Fusionner jusqu'à dernière colonne contenant
Réponses
8
Affichages
680
TooFatBoy
T
  • Résolu(e)
XL 2016 macro et feuille protégé
2
Réponses
18
Affichages
728
laurent950
K
  • Résolu(e)
XL 2016 Affichage TextBox
Réponses
6
Affichages
87
KRUG WOO
K
  • Question Question
Microsoft 365 Trier des données et les afficher sur une autre feuille
Réponses
10
Affichages
405
Jojo973
S
  • Résolu(e)
Microsoft 365 VBA Match: comment éviter l'erreur?
2
Réponses
29
Affichages
541
Dranreb
G
  • Résolu(e)
XL 2016 Pb de tri et sous totaux
2
Réponses
27
Affichages
297
Gestionnaire_rh
G
B
  • Question Question
XL 2019 Dans une macro de démarrage de fichier masquer le code par des Astérix ou point
Réponses
3
Affichages
84
sylvanu
  • Résolu(e)
XL 2016 En VBA, Automatiser la réponse en fonction de l'état d'une cellule.
Réponses
7
Affichages
66
piga25
N
  • Résolu(e)
Microsoft 365 Recherche dans un tableau structuré à partir d'une TextBox
Réponses
11
Affichages
397
NONO14
N
  • Question Question
XL 2016 Protéger Plage avec condition
2
Réponses
16
Affichages
965
Amigo
U
  • Question Question
Autres incorporer une macro dans une autre macro
Réponses
5
Affichages
368
Phil69970
B
  • Question Question
XL 2013 Comment trier les nom des feuilles et fusionner leur tableaux dans une une autre feuille ?
Réponses
10
Affichages
590
Compte Supprimé 979
C
A
  • Question Question
VBA qui fonctionnait avant, mais ne fonctionne plus avec le 64 bits
Réponses
2
Affichages
213
patricktoulon
C
  • Question Question
XL 2021 Problème de remplissage d'une colonne conditionné à d'autres valeurs
Réponses
2
Affichages
418
CathyLD
C
D
  • Question Question
Microsoft 365 Dupliquer des lignes dans une autre feuille avec une condition
2
Réponses
26
Affichages
2 K
de_hanstrapp
D
  • Question Question
XL 2021 Comment supprimer des noms du gestionnaire de noms dans un classeur
Réponses
7
Affichages
377
jeff1494
S
  • Résolu(e)
XL 2016 Coller nom classeur sur plage cellules
Réponses
9
Affichages
93
safranien
S
  • Question Question
XL 2010 Comment lire array dans item dictionnaire
2 3
Réponses
33
Affichages
2 K
cathodique
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…