Ajout de données automatique depuis un autre tableau

Bonjour à tous,

Je vais tenter de vous expliquer clairement le souci que je rencontre et ce que j'aimerai faire.

Je dispose d'un premier classeur Excel "Faune_Habitats_Statuts" dans lequel j'ai répertorié toutes les espèces que j'ai rencontrées, avec leur habitat et statut de protection.

Mon deuxième classeur est également une liste d'espèce que j'aimerai remplir automatiquement en me servant du premier classeur.

Les colonnes ont les même noms, et j'aimerai remplir les colonnes "Habitat", "Protection" et "Statut" en demandant à Excel de chercher le nom de l'espèce dans le premier tableau.

Est-ce faisable ? Je ne sais pas si je me suis bien exprimé, j'espère que vous m'aurez compris Je vous joins les 2 fichiers.

J'ai tenté la formule =RECHERCHEV mais ça me donne des résultats improbables à chaque fois :/

9faune-combo.xlsx (34.97 Ko)

Bonsoir Asmodehus,

Le code est à placer dans un module standard du classeur "Faune_Combo.xlsm" soit le classeur cible

Dans quelles feuilles du classeur cible, faut-il ventiler les données peux-tu nous le préciser

Option Explicit
Sub test()
Dim a, dico As Object, i As Long, ws As Worksheet
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    Application.ScreenUpdating = False
    With Workbooks.Open(ThisWorkbook.Path & "\Faune_Habitats_Statuts.xls")    'source
        For Each ws In .Worksheets([{"Invertébrés","Vertébrés"}])
            a = ws.Cells(1).CurrentRegion.Value
            For i = 2 To UBound(a, 1)
                dico(a(i, 2)) = VBA.Array(a(i, 3), a(i, 4))
            Next
        Next
        .Close False
    End With
    With ThisWorkbook    'cible
        For Each ws In .Worksheets([{"Faune","Flore"}]) '<---- ventilation ?
            With ws.Cells(1).CurrentRegion
                .Offset(1).Columns("c:d").ClearContents
                For i = 2 To .Rows.Count
                    If dico.exists(.Cells(i, 2).Value) Then
                        .Cells(i, 3).Resize(, 2).Value = dico(.Cells(i, 2).Value)
                    End If
                Next
            End With
        Next
    End With
    Application.ScreenUpdating = True
    Set dico = Nothing
End Sub

klin89

Bonjour,

La formule RECHERCHEV() revisitée en supprimant certains espaces indésirables.

Puis vérifier l'orthographe, etc...

Cdlt.

=RECHERCHEV(SUBSTITUE(SUBSTITUE(B2;" )";")");CAR(160);CAR(32));[Faune_Habitats_Statuts.xlsx]Total!B$2:E$733;2;FAUX)

Bonjour,

Merci de vos réponse,

C'est dans la feuille "Faune total" que j'aimerai ajouter mes données, la fonction RECHERCHEV m'a permis de faire ce que je voulais finalement Merci

Rechercher des sujets similaires à "ajout donnees automatique tableau"