extraction d'un fichier vers un autre

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion NICOALBERT
  • Date de début Date de début

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
N

NICOALBERT

XLDnaute Occasionnel
Bonjour a tt le forum.

Je viens vers vous car je suis entrain de réaliser une base de donnée sur le turf. et je voudrais importer des informations d'un fichier vers un autre selon critère. j'ai deux fichier le 1er:"2008" qui est la base, et le 2èm: "Etude cheval". ce que je voudrais c'est que selon le nom du cheval se trouvant en I3 du fichier Etude cheval, on extrait tous les lignes ou le nom du cheval se trouve dans le fichier "2008" dans les feuilles 1 et 2.

Pouvez vous m'aider . en vous remerciant d'avance.
 

Pièces jointes

Trier par date Trier par votes
Re : extraction d'un fichier vers un autre

Bonjour à Tous,

Dans le classeur "Etude Cheval" chaque ligne trouver dans le classeur "2008" doit pouvoir se mettre a la ligne autant de fois que nécessaire.

j'ai tt essayer , même avec l'enregistreur de macro mais je ni arrive pas, pouvez vous m'aider?

merci a tous.
 
Vote positif 0 Vote négatif
Re : extraction d'un fichier vers un autre

Bonjour NICOALBERT,

Le fichier "Etude cheval" ne paraît pas au point, il faut le revoir.

Avec au moins une liste déroulante (de validation) pour choisir le cheval...

Et des champs correspondant au fichier "2008"...

A+
 
Vote positif 0 Vote négatif
Re : extraction d'un fichier vers un autre

Re,

Dans le fichier "Etude cheval.xls" :

1) j'ai créé la feuille "Liste" avec cette macro qui met à jour la liste des chevaux, sans doublons :

Code: 
Private Sub CommandButton1_Click()
Dim d As Object, w As Worksheet, cel As Range
Set d = CreateObject("Scripting.Dictionary")
On Error Resume Next
For Each w In Workbooks("2008.xls").Worksheets
  For Each cel In w.Range("N2", w.Range("N65536").End(xlUp))
    If Not d.exists(cel.Value) Then d.Add cel.Value, cel.Value
  Next
Next
Range("A1").Resize(d.Count) = Application.Transpose(d.items)
Columns(1).Sort [A1], 1 'tri ascendant
End Sub

2) dans le code de la feuille "Cheval" :

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Target.Cells(1, 1)
If Target.Address <> "$I$3" Then Exit Sub
Dim lig As Integer, w As Worksheet, cel As Range
lig = 5
Rows("5:65536").Clear 'vide la plage de recopie
If Target = "" Then Exit Sub
Application.ScreenUpdating = False
On Error Resume Next
For Each w In Workbooks("2008.xls").Worksheets
  If Err Then MsgBox "Ouvrez le fichier '2008.xls' !!": Exit Sub
  For Each cel In w.Range("N2", w.Range("N65536").End(xlUp))
    If cel = Target Then
      cel.EntireRow.Copy Rows(lig)
      lig = lig + 1
    End If
  Next
Next
Rows("5:65536").WrapText = False 'évite les retours à la ligne
End Sub

La macro se déclanche quand on choisit un cheval dans la liste de validation en I3.

A+
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Re : extraction d'un fichier vers un autre

Un grand merci , sa fonctionne très bien.

Mais est ce qu'il est possible de réaliser la même chose mais sans liste dèroulante , car dans mon fichier le nom du cheval se met en place automatiquement par une autre macro et j'ai des recherches sur toute la page. sur chaque Feuille j'ai 4 réunions de 9 courses chacune et 20 chevaux par courses. donc la je met un bout de fichier qui ne représente que la course N°1 de la réunion 1.

encore merci pour le temps que vous prenez à nous aider dans nos galère.
 

Pièces jointes

Vote positif 0 Vote négatif
Re : extraction d'un fichier vers un autre

Bonsoir NICOALBERT,

Cette macro se lance quand on renseigne (ou valide) la cellule I3 et celles semblables plus bas en colonne I :

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Target.Cells(1, 1)
If Target.Offset(1) <> "Allocation" Then Exit Sub
Dim lig&, derlig&, w As Worksheet, cel As Range
lig = Target.Row + 2
derlig = Target.EntireColumn.Find("Allocation", After:=Target.Offset(1), LookIn:=xlValues).Row - 2
If derlig < lig Then derlig = 65536
Rows(lig & ":" & derlig).Clear 'vide la plage de recopie
If Target = "" Then Exit Sub
Application.ScreenUpdating = False
On Error Resume Next
For Each w In Workbooks("2008.xls").Worksheets
  If Err Then MsgBox "Ouvrez le fichier '2008.xls' !!": Exit Sub
  For Each cel In w.Range("N2", w.Range("N65536").End(xlUp))
    If cel = Target Then
      cel.EntireRow.Copy Rows(lig)
      If lig = derlig Then MsgBox "Dernière ligne disponible !": GoTo 1
      lig = lig + 1
    End If
  Next
Next
1 Rows(Target.Row + 2 & ":" & derlig).WrapText = False 'évite les retours à la ligne
End Sub

Noter que le repérage se fait par les cellules contenant "Allocation".

Fichier (2) joint.

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Re : extraction d'un fichier vers un autre

Bonjour NICOALBERT,

Vous avez bien dit "cheval et jockeys".

Voici la macro modifiée (en rouge) :

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Target.Cells(1, 1)
If Target.Offset(1) <> "Allocation" [COLOR="Red"]And Target.Offset(1) <> "CHEVAUX"[/COLOR] Then Exit Sub
Dim lig&, derlig&, w As Worksheet, cel As Range
lig = Target.Row + 2
derlig = [COLOR="red"]Columns("I")[/COLOR].Find("Allocation", After:=[COLOR="red"]Cells(Target.Row + 1, "I")[/COLOR], LookIn:=xlValues).Row - 2
If derlig < lig Then derlig = 65536
Rows(lig & ":" & derlig).Clear 'vide la plage de recopie
If [COLOR="red"]Cells(Target.Row, "I") = "" Or Cells(Target.Row, "N") = ""[/COLOR] Then Exit Sub
Application.ScreenUpdating = False
On Error Resume Next
For Each w In Workbooks("2008.xls").Worksheets
  If Err Then MsgBox "Ouvrez le fichier '2008.xls' !!": Exit Sub
  For Each cel In w.Range("N2", w.Range("N65536").End(xlUp))
    If [COLOR="red"]cel = Cells(Target.Row, "I") And cel.Offset(, 6) = Cells(Target.Row, "N")[/COLOR] Then
      cel.EntireRow.Copy Rows(lig)
      If lig = derlig Then MsgBox "Dernière ligne disponible !": GoTo 1
      lig = lig + 1
    End If
  Next
Next
1 Rows(Target.Row + 2 & ":" & derlig).WrapText = False 'évite les retours à la ligne
End Sub

A+
 
Vote positif 0 Vote négatif
Re : extraction d'un fichier vers un autre

Re,

Bon, j'anticipe la demande suivante.

Cette macro édite la liste si les 2 critères, cheval (colonne I) et jockey (colonne N) sont renseignés, ou si un seul des deux est renseigné :

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Target.Cells(1, 1)
If Target.Offset(1) <> "Allocation" And Target.Offset(1) <> "CHEVAUX" Then Exit Sub
Dim lig&, derlig&, [COLOR="Red"]t1$, t2$,[/COLOR] w As Worksheet, cel As Range
lig = Target.Row + 2
derlig = Columns("I").Find("Allocation", After:=Cells(Target.Row + 1, "I"), LookIn:=xlValues).Row - 2
If derlig < lig Then derlig = 65536
Rows(lig & ":" & derlig).Clear 'vide la plage de recopie
[COLOR="Red"]t1 = Cells(Target.Row, "I"): t2 = Cells(Target.Row, "N")[/COLOR]
If t1 = "" [COLOR="red"]And[/COLOR] t2 = "" Then Exit Sub
Application.ScreenUpdating = False
On Error Resume Next
For Each w In Workbooks("2008.xls").Worksheets
  If Err Then MsgBox "Ouvrez le fichier '2008.xls' !!": Exit Sub
  For Each cel In w.Range("N2", w.Range("N65536").End(xlUp))
    If ([COLOR="red"]t1 = "" Or[/COLOR] cel = t1) And ([COLOR="red"]t2 = "" Or[/COLOR] cel.Offset(, 6) = t2) Then
      cel.EntireRow.Copy Rows(lig)
      If lig = derlig Then MsgBox "Dernière ligne disponible !": GoTo 1
      lig = lig + 1
    End If
  Next
Next
1 Rows(Target.Row + 2 & ":" & derlig).WrapText = False 'évite les retours à la ligne
End Sub

Edit : j'ai introduit les variables t1 et t2, la macro sera plus rapide.

A+
 
Dernière édition:
Vote positif 0 Vote négatif
Re : extraction d'un fichier vers un autre

Bonjour,

un grand merci à JOB 75 pour le temps pris pour m'aider avec mon problème.Les différents programmes fonctionnent très bien sauf si on veut s'en servir pour des nombres (exemple le cheval CHELSEA HOTEL pour un poids de 58 KG , il ne me trouve pas de résultat alors qu'il y en a un)

Pourtant j'ai modifier le programme pour pour qu'il sélectionne la bonne colonne dans le classeur 2008,mais sa ne fonctionne pas.

Est ce normal , ou c'est moi qui mis prend très mal ce que je ne doute pas?

Cordialement NICOALBERT
 
Vote positif 0 Vote négatif
Re : extraction d'un fichier vers un autre

Bonjour NICOALBERT,

Vous voulez donc une étude cheval + poids.

Faites la recherche en convertissant les nombres en texte (String) :

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Target.Cells(1, 1)
If Target.Offset(1) <> "Allocation" And Target.Offset(1) <> "CHEVAUX" Then Exit Sub
Dim lig&, derlig&, t1$, t2$, w As Worksheet, cel As Range
lig = Target.Row + 2
derlig = Columns("I").Find("Allocation", After:=Cells(Target.Row + 1, "I"), LookIn:=xlValues).Row - 2
If derlig < lig Then derlig = 65536
Rows(lig & ":" & derlig).Clear 'vide la plage de recopie
t1 = Cells(Target.Row, "I"): t2 = Cells(Target.Row, "N")
If t1 = "" And t2 = "" Then Exit Sub
Application.ScreenUpdating = False
On Error Resume Next
For Each w In Workbooks("2008.xls").Worksheets
  If Err Then MsgBox "Ouvrez le fichier '2008.xls' !!": Exit Sub
  For Each cel In w.Range("N2", w.Range("N65536").End(xlUp))
    If (t1 = "" Or cel = t1) And (t2 = "" Or [COLOR="Red"]CStr(cel.Offset(, 4))[/COLOR] = t2) Then
      cel.EntireRow.Copy Rows(lig)
      If lig = derlig Then MsgBox "Dernière ligne disponible !": GoTo 1
      lig = lig + 1
    End If
  Next
Next
1 Rows(Target.Row + 2 & ":" & derlig).WrapText = False 'évite les retours à la ligne
End Sub

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Re : extraction d'un fichier vers un autre

Bonjour,

je me retourne vers vous car j'ai un soucis, vos programme fonctionne très bien, et je vous en remercie.

Mais mon soucis c'est que cela fonctionne très bien avec le morceau de fichier que je vous ai joint. Mais avec la vrai base ( 20 Pages de 66 Colonnes et environ 30000 Lignes/page).Dès que je fait ma recherche exemple cheval N°1 sa m'efface tous ce qu'il y a en dessous même s'il n'y a que 5 résultats alors que j'ai prévue 85 lignes.

Pourriez vous m'aider .

Merci par avance.NICOALBERT
 
Vote positif 0 Vote négatif
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

C
  • Résolu(e)
XL 2016 Valeurs d'un tableau à un autre et insérer dates
Réponses
6
Affichages
187
Collins
C
F
  • Question Question
Microsoft 365 Vba : copier certaines cellules suivant la valeur d'une autre
Réponses
2
Affichages
284
mapomme
mapomme
B
  • Question Question
XL 2016 Modification dee propriétés d'un fichier externe
Réponses
10
Affichages
340
bernardrustrel
B
C
  • Résolu(e)
XL 2021 Mise en page pour imprimer un fichier trié et filtré
Réponses
3
Affichages
93
sylvanu
sylvanu
D
  • Résolu(e)
Microsoft 365 récupérer des données d'une feuille excel d'un classeur A pour les incrémenter automatiquement sur le classeur B
Réponses
10
Affichages
427
TooFatBoy
TooFatBoy
U
  • Résolu(e)
XL 2016 Création d'un fichier excel à partir d'un bouton
Réponses
7
Affichages
472
Utilisateur_X
U
jeff1494
  • Résolu(e)
XL 2021 Export d'un Userform au format Docx;
3 4 5
Réponses
60
Affichages
1 K
job75
job75
T
  • Résolu(e)
Microsoft 365 Exporter les plages nommées vers un nouveau classeur - plage nommée invalide selon VBA
Réponses
2
Affichages
492
tnion
T
D
  • Question Question
Microsoft 365 transcription d'un fichier Excel sur PPT, avec mise à jour automatique
Réponses
4
Affichages
332
Daniel200666
D
O
  • Question Question
XL 2016 transférer les données d'un tableau brut, dans un autre format pour analyse.
Réponses
12
Affichages
745
ORL
O
jeff1494
  • Résolu(e)
XL 2021 Extraction images depuis commentaire de cellule vers dossier.
11 12 13
Réponses
182
Affichages
4 K
patricktoulon
patricktoulon
cathodique
  • Résolu(e)
XL 2010 [RESOLU] Rendre Fonction Générique
Réponses
2
Affichages
317
cathodique
cathodique
D
  • Résolu(e)
Microsoft 365 Récupérer la valeur d'une cellule d'un autre fichier
Réponses
7
Affichages
599
Diane272727
D
O
  • Question Question
XL 2013 Recopier automatique des valeurs d'un onglet vers un autre onglet selon critère
Réponses
2
Affichages
792
olivieroma
O
D
  • Question Question
Microsoft 365 Procédé pour appliquer un filtre qui permet de ressortir les informations a la sélection d'une information dans une colonne.
Réponses
6
Affichages
296
djidji59430
djidji59430
A
  • Question Question
XL 2010 Filtrer un Combobox en VBA excel
2 3
Réponses
43
Affichages
3 K
Dranreb
Dranreb
F
  • Question Question
XL 2021 Liste déroulante vers un autre classeur
Réponses
1
Affichages
552
Dudu2
Dudu2
jcf6464
  • Question Question
Microsoft 365 Contrôle sur nom et prénom d'un classeur a l'autre classeur
Réponses
10
Affichages
543
jcf6464
jcf6464
kkamadou
  • Question Question
importation de donnees dans un fichier excel dans un formulaire
Réponses
3
Affichages
633
kkamadou
kkamadou
P
  • Question Question
Microsoft 365 Publipostage avec Excel
Réponses
10
Affichages
1 K
Sequoyah
Sequoyah
Retour