MACRO: localiser et extraire les données + les ranger dans un tableau

falconoz

XLDnaute Nouveau
bonjour à tous
mon souci c'est que je cherche à avoir (avec macro si possible) un tableau récapitulatif dans la feuil "efg" (voir fichier joint). la macro parcours la colonne A dans la feuil "abc" et dès qu'elle tombe sur une donnée, la copie avec sa donnée (ou ses données ) correspondante de la colonne C dans la feuil "efg" comme le montre le fichier ci-joint.
j'attends vos réponse avec impatiente et sachez que je suis vraiment nul en VBA donc si vous utiliser des formules compliquées, essayer si vous pouvez de mettre un max de commentaires.
 

Pièces jointes

  • exemple1.xls
    14.5 KB · Affichages: 138
  • exemple1.xls
    14.5 KB · Affichages: 152
  • exemple1.xls
    14.5 KB · Affichages: 145

GCFRG

XLDnaute Occasionnel
Re : MACRO: localiser et extraire les données + les ranger dans un tableau

Salut Falconoz, peux tu apporté des précisions, en effet, données a b c, données 1 2 3, çà veut pa dire grand chose.je suppose que ton fichier final ne comporteras pas ces valeurs.
tu peux par exemple attribué une couleur pour regrouper tes données, données A en jaune, B en bleu, etc.
on pourra ainsi faire une recherche sur Interior.CouleurIndex
l'idéal étant d'avoir une constante pour chaque type de données

Voilà voilà.
Gilbert
 

falconoz

XLDnaute Nouveau
Re : MACRO: localiser et extraire les données + les ranger dans un tableau

Bonjour GCFRG
en fait les couleurs ne font pas partie de mon fichier d'origine! ils sont la juste pour éclaircir le fichier. les données abc ou 1 2 3 sont des chaine de caractères. n'hésite pas si t'a d'autre question et des propositions.
merci d'avance
 

job75

XLDnaute Barbatruc
Re : MACRO: localiser et extraire les données + les ranger dans un tableau

Bonjour falconoz, GCFRG,

Fichier ci-joint avec la macro :

Code:
Sub Transfert()
Dim cel As Range, ref As Range
Application.ScreenUpdating = False
ActiveSheet.AutoFilterMode = False
Sheets("efg").Range("6:65536").Clear
On Error Resume Next
For Each cel In Range("A5:A" & Range("A65536").End(xlUp).Row)
  If Application.CountIf(Range("A5:A" & cel.Row), cel) = 1 Then
    Set ref = Sheets("efg").Range("B65536").End(xlUp)(2)
    cel.Copy ref.Offset(0, -1)
    Range("A4:C65536").AutoFilter Field:=1, Criteria1:=cel
    Range("C5:C" & Range("C65536").End(xlUp).Row).SpecialCells(xlVisible).Copy ref
    Range("A4:C65536").AutoFilter
  End If
Next
Application.ScreenUpdating = True
End Sub

A+
 

Pièces jointes

  • falconoz.xls
    36.5 KB · Affichages: 168
  • falconoz.xls
    36.5 KB · Affichages: 165
  • falconoz.xls
    36.5 KB · Affichages: 164

falconoz

XLDnaute Nouveau
Re : MACRO: localiser et extraire les données + les ranger dans un tableau

Bonjour job75
rebonjour à tous
franchement tu as de la chance de savoir manipuler des macros en un espace de temps très réduit. je ne sais pas comment vous avez appris et combien de temps il faut pour ça!!! en tous cas la macro a l'air de fonctionner à merveil mais stp est ce que tu peux commenter cette macro (notament les A65000... de quel A s'agit it? dans la feuil"abc" ou feuil"efg") pour que je puisse l'adapater à mon fichier excel.

merci beaucoup en tout cas
 

job75

XLDnaute Barbatruc
Re : MACRO: localiser et extraire les données + les ranger dans un tableau

Re,

Quand la feuille n'est pas précisée devant Range, il s'agit de la feuille active (donc de la feuille qui contient le bouton qui lance la macro).

J'ai mis des commentaires partout :

Code:
Sub Transfert()
Dim cel As Range, ref As Range
Application.ScreenUpdating = False 'l'écran est figé
ActiveSheet.AutoFilterMode = False ' retire le filtre automatique au cas où il serait en place
Sheets("efg").Range("6:65536").Clear ' efface tout à partir de la ligne 6 feuille efg
For Each cel In Range("A5:A" & Range("A65536").End(xlUp).Row) ' feuille active : étudie les cellules de la colonne A
  If Application.CountIf(Range("A5:A" & cel.Row), cel) = 1 Then 's'il s'agit d'une nouvelle valeur (CountIf est l'équivalent de NB.SI)
    Set ref = Sheets("efg").Range("B65536").End(xlUp)(2) ' ref = cellule sous la dernière cellule colonne B feuille efg
    cel.Copy ref.Offset(0, -1) ' cellule à gauche de la précédente
    Range("A4:C65536").AutoFilter Field:=1, Criteria1:=cel ' feuille active : mise en place du filtre et filtrage suivant valeur colonne A
    Range("C5:C" & Range("C65536").End(xlUp).Row).SpecialCells(xlVisible).Copy ref 'copie de la zone filtrée colonne C vers ref
    Range("A4:C65536").AutoFilter ' le filtre est retiré
  End If
Next
Application.ScreenUpdating = True
End Sub

A+
 

Pièces jointes

  • falconoz.xls
    36.5 KB · Affichages: 161
  • falconoz.xls
    36.5 KB · Affichages: 163
  • falconoz.xls
    36.5 KB · Affichages: 174

GCFRG

XLDnaute Occasionnel
Re : MACRO: localiser et extraire les données + les ranger dans un tableau

Salut, falconoz, job75,

Excelente méthode que de faire 1 tri avant de copier les données, je m'en souviendrais
je vais archiver çà

Merci @+

Gilbert
 

Discussions similaires

Réponses
16
Affichages
565

Statistiques des forums

Discussions
312 499
Messages
2 089 002
Membres
104 002
dernier inscrit
SkrauzTTV