recherche valeur et déplacement dans un autre fichier

Neofalken

XLDnaute Junior
Bonjour le forum

continuant dans ma lancée de petit développeur débutant je me retrouve bloqué.

Je voudrais créer une macro qui permettrait de rechercher une valeur dans une ou plusieurs lignes puis de récupérer toutes les valeurs de cette/ces lignes et les insère dans un fichier excel défini en y insérant ces valeurs.

exemple
24 25 56 87 A
45 26 15 15 B
48 45 45 100 A



La macro recherche toutes les lignes où on a "A", récupère toutes les valeurs des lignes où ya A, et me les reporte dans un fichier bien défini (genre valeur_A.xls)
Meme chose pour B, etc..

J'obtiendrai alors dans le fichier "valeur_A.xls"

24 25 56 87 A
48 45 45 100 A

Et dans le fichier "valeur_B.xls"

45 26 15 15 B


Merci d'avance pour votre aide précieuse

Neofalken
 

Pièces jointes

  • Classeur1.xlsx
    8.2 KB · Affichages: 52
  • Classeur1.xlsx
    8.2 KB · Affichages: 51
  • Classeur1.xlsx
    8.2 KB · Affichages: 58

job75

XLDnaute Barbatruc
Re : recherche valeur et déplacement dans un autre fichier

Bonsoir à tous,

Une solution VBA avec cette macro dans Module1 (Alt+F11) :

Code:
Sub CreerFichiers()
Dim h&, d As Object, cel As Range, k, plage As Range
Application.ScreenUpdating = False 'fige l'écran
Application.DisplayAlerts = False 'si un fichier existe déjà
ActiveSheet.AutoFilterMode = False 'au cas où le filtre est activé
h = [A65536].End(xlUp).Row
'---liste des valeurs sans doublon---
Set d = CreateObject("Scripting.Dictionary")
For Each cel In [E1].Resize(h)
  If cel <> "" Then d(cel.Value) = cel.Value
Next
'---filtrage de chaque valeur et création fichier---
[1:1].Insert 'insertion ligne nécessaire pour le filtrage
For Each k In d.keys
  [E1].Resize(h + 1).AutoFilter 1, k
  Set plage = [A2].Resize(h, 5).SpecialCells(xlCellTypeVisible)
  Workbooks.Add 'nouveau document
  plage.Copy [A1]
  ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & k & ".xls" 'à adapter
  ActiveWorkbook.Close 'fermeture du fichier
Next
ActiveSheet.AutoFilterMode = False
[1:1].Delete
End Sub
Fichier joint.

Edit 1 : attention à ne pas mettre en colonne E des caractères interdits pour les noms de fichier...

Edit 2 : avant de lancer la macro s'assurer qu'il n'y a pas de fichier A.xls B.xls C.xls... ouvert.

A+
 

Pièces jointes

  • Créer fichiers(1).xls
    45.5 KB · Affichages: 37
  • Créer fichiers(1).xls
    45.5 KB · Affichages: 35
  • Créer fichiers(1).xls
    45.5 KB · Affichages: 40
Dernière édition:

job75

XLDnaute Barbatruc
Re : recherche valeur et déplacement dans un autre fichier

Bonjour le fil, le forum,

Avec ce fichier (2) le filtrage se fait dans le nouveau document.

De cette manière les formats sont copiés :

Code:
Sub CreerFichiers()
Dim C As Range, h&, d As Object, cel As Range, k, plage As Range
Application.ScreenUpdating = False 'fige l'écran
Application.DisplayAlerts = False 'si un fichier existe déjà
ActiveSheet.AutoFilterMode = False 'au cas où le filtre est activé
Set C = Cells
h = [A65536].End(xlUp).Row
'---liste des valeurs sans doublon---
Set d = CreateObject("Scripting.Dictionary")
For Each cel In [E1].Resize(h)
  If cel <> "" Then d(cel.Value) = cel.Value
Next
'---création des fichier---
For Each k In d.keys
  Workbooks.Add 'nouveau document
  C.Copy [A1] 'copie les cellules
  [1:1].Insert 'insertion ligne nécessaire pour filtrer
  [E1].Resize(h + 1).AutoFilter 1, "<>" & k 'filtrage
  Set plage = [E1].Resize(h + 1).SpecialCells(xlCellTypeVisible)
  ActiveSheet.AutoFilterMode = False
  plage.EntireRow.Delete 'suppression des cellules filtrées (avec ligne 1)
  ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & k & ".xls" 'à adapter
  ActiveWorkbook.Close 'fermeture du fichier
Next
End Sub
A+
 

Pièces jointes

  • Créer fichiers(2).xls
    47 KB · Affichages: 21
  • Créer fichiers(2).xls
    47 KB · Affichages: 27
  • Créer fichiers(2).xls
    47 KB · Affichages: 29

job75

XLDnaute Barbatruc
Re : recherche valeur et déplacement dans un autre fichier

Re,

S'il y a une ligne de titres, il faut procéder un peu différemment :

Code:
Sub CreerFichiers()
Dim C As Range, h&, d As Object, cel As Range, k, plage As Range
Application.ScreenUpdating = False 'fige l'écran
Application.DisplayAlerts = False 'si un fichier existe déjà
ActiveSheet.AutoFilterMode = False 'au cas où le filtre est activé
Set C = Cells
h = [A65536].End(xlUp).Row
If h = 1 Then Exit Sub
'---liste des valeurs sans doublon---
Set d = CreateObject("Scripting.Dictionary")
For Each cel In [E2].Resize(h - 1)
  If cel <> "" Then d(cel.Value) = cel.Value
Next
'---création des fichier---
For Each k In d.keys
  Workbooks.Add 'nouveau document
  C.Copy [A1] 'copie les cellules
  [E1].Resize(h).AutoFilter 1, "<>" & k 'filtrage
  Set plage = [E2].Resize(h).SpecialCells(xlCellTypeVisible)
  ActiveSheet.AutoFilterMode = False
  plage.EntireRow.Delete 'suppression des cellules filtrées
  ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & k & ".xls" 'à adapter
  ActiveWorkbook.Close 'fermeture du fichier
Next
End Sub
Fichier (3).

A+
 

Pièces jointes

  • Créer fichiers(3).xls
    56.5 KB · Affichages: 31
  • Créer fichiers(3).xls
    56.5 KB · Affichages: 35
  • Créer fichiers(3).xls
    56.5 KB · Affichages: 37

Neofalken

XLDnaute Junior
Re: Re : recherche valeur et déplacement dans un autre fichier

Bonjour Job75, le Forum

Merci tout d'abord de t'être penché sur mon problème. Je pensais pouvoir adapter la réponse que j'obtiendrais en fonction de mes besoins (j'ai simplifié la demande) mais mes connaissances en la matière ne sont pas suffisantes, donc je vais être un peu plus clair et précis dans ma demande.
En fait j'ai au final 18 colonnes (voir fichier joint), j'aimerais également inclure dans la récupération des données la valeur qui est après la colonne de référence (anciennement A, B, C, ici Format 1, Format 2 et Format 3).
La base est tjrs la même : récupération des lignes selon la colonne format 1, 2 et 3
Puis création d'un fichier pour chaque format.
Il peut y avoir des colonnes vides dans une ligne.
Désolé de ne pas avoir été plus clair au départ

Merci encore pour ton, votre aide
 

Pièces jointes

  • Créer fichiers(1).xls
    39 KB · Affichages: 32
  • Créer fichiers(1).xls
    39 KB · Affichages: 36
  • Créer fichiers(1).xls
    39 KB · Affichages: 33

job75

XLDnaute Barbatruc
Re : recherche valeur et déplacement dans un autre fichier

Bonjour Neofalken, le fil,

Même "petit" développeur débutant, vous devriez savoir qu"une macro ça s'adapte.

Dans votre fichier il n'y a pas d'en-têtes de colonnes, donc prenez la macro du fichier (2) post #5.

Et comme les noms à filtrer sont en colonne P remplacez E1 par P1 :cool:

Si vous prenez le temps de tester et de comprendre 30 secondes cette macro, vous verrez que le nombre de colonnes n'a aucune importance.

A+
 

Neofalken

XLDnaute Junior
Re: Re : recherche valeur et déplacement dans un autre fichier

Bonjour Job75, le forum

Merci, mais c'est ce que j'avais tenté de faire (E1 par P1) sans résultat satisfaisant.
C'est pour ça que je ne comprenais pas et me demandais s'il n'y avait pas un autre problème..
Je vais retenter...
 

Neofalken

XLDnaute Junior
Re: Re : recherche valeur et déplacement dans un autre fichier

Bon, je ne sais pas ce que j'avais fait comme manip l'autre fois, mais il me semblait avoir fait ce qui a été décrit, mais apparemment non, puisque je viens de la refaire et cette fois-ci ça fonctionne...

le "pan dan ta g.." était un peu mérité...je l'admets...

Ok, merci bcp pour ton aide Job75
 

Discussions similaires

Statistiques des forums

Discussions
314 588
Messages
2 110 988
Membres
111 002
dernier inscrit
Lolo73i