Recherche de valeurs d'une feuille à une autre

Bonjour,

Dans un fichier, j'ai deux feuille (feuille1, Aurice). Sur ces deux feuilles j'ai un tableau identique.

Je souhaiterai que dans la feuille intitulée "Aurice" n'apparaissent que les informations ayant un rapport avec le site Aurice. C'est à dire qu'il aille chercher dans la "Feuille1" et que si il rencontre le nom Aurice dans la colonne "Site" de cette Feuille1 qu'il reprenne les informations dans les colonnes Resp, Code action, Numéro, Site, Type, Année (intitulé de colonne) pour les intégrer dans la feuille intitulée "Aurice".

Je joins le fichier, j'espère qu'il sera plus clair.

Merci.

Re

Est-ce que tu ne traites que AURICE ou les autres villes ont un onglet également ?

A te relire

Amicalement

Nad

Bonjour,

Il y a quelque chose qui me dérange dans ton fichier, ce sont les sites :

• Pôle foie gras
• Pôle foie gras Traiteur
• Pôle foie gras, Traiteur, Salaison

notamment le dernier, car il comporte plus de 31 caractères, donc on ne peut pas nommer un onglet avec ce nom (limite de caractères pour le nom d'un onglet : 31)

J'ai également modifié tes cellules B6:C6 pour n'en faire qu'une

regarde le fichier joint, j'extrais tous les sites dans un onglet séparé, mais il y a des erreurs dans les onglets cités supra..

Edit : bonjour, Nad

Si cela te va...

Bonjour, salut Nad

Si tu ne traites qu'Aurice, l'enregistreur de Macro suffit

Sub Aurice()
' Macro enregistrée le 01/07/2010 par Amadéus
    Range("B8").Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=4, Criteria1:="Aurice"
    Range("B12:G12").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Aurice").Select
    Range("B8").Select
    ActiveSheet.Paste
    Range("B8").Select
    Sheets("Feuille1").Select
    Range("D4").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
End Sub

Cordialement

Bonjour à vous tous,

Pour les autres villes : oui il y aura un onglet par ville

Pour les Pôles foie gras,.... : ces informations seront supprimées. Donc n'en tenez pas compte.

Amadeus : j'ai intégré ta macro mais il me fait appraître une erreur avec comme seule explication le chiffre 400.De plus la feuille 1 est triée mais je voudrai qu'il aille chercher les valeurs de la cellule B8 à G318 et sur une feuille non triée.

Je remets le tableau mais avec la feuille 1 non triée.

Merci.

Re-,

Bonjour, Amadéus

Thomas, as-tu regardé mon fichier?

Cousinhub,

Excuse j'ai été trop rapide mais en tout cas je te félicite car c'est vraiment ce que je veux.

Je vais reprendre cette macro et l'intégrer dans mon fichier original en espérant qu'il n'y ai pas de surprise.

Je te tiens au courant.

-- 01 Juil 2010, 17:54 --

Re-bonjour cousinhub,

Fausse alerte, la macro une fois intégrée dans mon fichier plante totalement.

Je te remets le fichier (l'original). Il est constitué de 4 onglets qui devront restés apparent.

La recherche devra se faire sur la feuille intitulée "Actions SMQ" uniquement.

Merci pour ton aide.

-- 02 Juil 2010, 12:25 --

Bonjour le forum,

Problème résolu. Pour en faire profiter tout le monde voici la macro :

Sub extract()
Dim Sh As Worksheet
Dim Cel As Range
Dim LesSites As Object
Dim LeNom As String
With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
End With
Set LesSites = CreateObject("Scripting.Dictionary")
For Each Sh In Sheets
    Next Sh
With Sheets("Actions SMQ")
    .Range("B6:G" & .[B65000].End(xlUp).Row).Name = "base"
    For Each Cel In .Range("E7", .[E65000].End(xlUp))
        If Cel.Value <> "" Then
            LeNom = IIf(Len(Application.Proper(Replace(Cel.Value, ",", ""))) > 31, Left(Application.Proper(Replace(Cel.Value, ",", "")), 31), _
                Application.Proper(Replace(Cel.Value, ",", "")))
            LesSites(LeNom) = LeNom
        End If
    Next Cel
    .[P1] = .[E6]
    For Each it In LesSites.Items
        .[P2] = it
        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = it
        .Range("base").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("P1:P2"), _
            CopyToRange:=Range("B6"), Unique:=False
        Columns.AutoFit
    Next it
    .[P1:P2].Clear
    .Select
End With
End Sub

Merci à ceux qui ont fait évoluer la solution.