Sujet Précédent Sujet Suivant

Macro Copiage Données colonnes sous conditions

Fermé
clemmfds Messages postés 2 Date d'inscription mercredi 13 juillet 2016 Statut Membre Dernière intervention 13 juillet 2016 - 13 juil. 2016 à 16:35
Gyrus Messages postés 3334 Date d'inscription samedi 20 juillet 2013 Statut Membre Dernière intervention 9 décembre 2016 - 13 juil. 2016 à 18:53
Bonjour,

Je début en VBA et voila ce sur quoi je réfléchis depuis 2 jours, sans résultat.

J'ai une feuille avec des commandes et un numéro du type 002030 : Feuille 1 ="Expe"

J'ai une autre feuille avec des données sur tous les articles qui possède une colonne qui a la même info donc le même numéro : Feuille 2 = "Articles"

Je souhaite rechercher la ligne correspondant dans la feuille 2 au numéro 002030 présent dans les deux feuilles et ajouter dans la feuille 1 une donnée d'une autre colonne de la même ligne dans la feuille 2.

Et répéter cela pour toutes les lignes de la feuille 1.

J'ai réussi à rechercher la cellule dans la feuille 2 pour une cellule mais je n'arrive pas à le mettre dans une boucle while is not empty ou for. Je n'arrive pas non plus à récupérer le numéro de la ligne (j'ai tenté range("Adresse").Row mais sans résultat) pour aller chercher la valeur d'une autre colonne dans cette ligne et la copier dans une colonne de la feuille 1.

Voila mon code actuellement :

Sub cherche_cellule()

Dim Valeur As String
Dim Recherche As Range
Dim Cherche As String
Dim Adresse As String
With Valeur = Worksheets("Expe").Range("H2").Value
Cherche = Worksheets("Expe").Range("H2").Value
End With
Set Recherche = Worksheets("Articles").Columns(4)
Set Art = Recherche.Cells.Find(what:=Cherche, lookAt:=xlWhole)
If Art Is Nothing Then
Adresse = Cherche & " n'est pas présent dans" & Recherche.Address
Else
Adresse = Art.Addresse
End If
MsgBox Adresse
End Sub

Merci beaucoup par avance !!!!!

PS : J'ai aussi essayé avec un TCD avec plusieurs pages mais sans résultat...
A voir également:

2 réponses

Réponse 1 / 2
Gyrus Messages postés 3334 Date d'inscription samedi 20 juillet 2013 Statut Membre Dernière intervention 9 décembre 2016 523
13 juil. 2016 à 17:18
Bonjour,

Essaie comme cela : 
Sub cherche_cellule()
Dim Msg As String
Dim Cel As Range, Art As Range
    With Worksheets("Expe")
        For Each Cel In .Range("H2", .Range("H" & Rows.Count).End(xlUp))
            Set Art = Worksheets("Articles").Columns(4).Find(Cel.Value, , xlValues, xlWhole)
            If Art Is Nothing Then
                Msg = Msg & Cel.Value & " n'est pas présent dans " & Worksheets("Articles").Columns(4).Address & Chr(10)
            Else
                Msg = Msg & Cel.Value & " est présent en " & Art.Address & Chr(10)
            End If
        Next Cel
        MsgBox Msg
    End With
End Sub

A+
0
clemmfds Messages postés 2 Date d'inscription mercredi 13 juillet 2016 Statut Membre Dernière intervention 13 juillet 2016
13 juil. 2016 à 17:44
Ca marche top ! Merci beaucoup !

J'ai essayé de compléter pour copier/coller mais il me met une erreur d'exécution "9" au niveau de la ligne en italique.

Sub cherche_cellule()

Dim Msg As String
Dim Cel As Range, Art As Range, Plan As Range
Dim Pal As String

With Worksheets("Expe")
For Each Cel In .Range("H2", .Range("H" & Rows.Count).End(xlUp))
Set Art = Worksheets("Articles").Columns(4).Find(Cel.Value, , xlValues, xlWhole)
If Art Is Nothing Then
Msg = Msg & Cel.Value & " n'est pas présent dans " & Worksheets("Articles").Columns(4).Address & Chr(10)
Else
Msg = Msg & Cel.Value & " est présent en " & Art.Address & Chr(10)
End If

Dim NbCol As Integer, NbRow As Integer
Dim CopyRange As Range, PasteRange As Range
Set CopyRange = Worksheets("Article").Cells(Art.Row, 5)
NbRow = MyRange.Rows.Count
NbCol = MyRange.Columns.Count
With Worksheets("Expe")
Set PasteRange = .Range(Cel.Row, 9)
End With
Next Cel
MsgBox Msg
End With

End Sub
0
Réponse 2 / 2
Gyrus Messages postés 3334 Date d'inscription samedi 20 juillet 2013 Statut Membre Dernière intervention 9 décembre 2016 523
13 juil. 2016 à 18:53
La feuille porte le nom "Articles" (et non pas "Article").

De plus, il me semble que tu te compliques la vie.
L'objet Art représente une cellule de la colonne D de la feuille "Articles".
La cellule adjacente en colonne E est Art.offset(,1)

Essaie comme cela : 
Sub cherche_cellule()
Dim Msg As String
Dim Cel As Range, Art As Range
    With Worksheets("Expe")
        For Each Cel In .Range("H2", .Range("H" & Rows.Count).End(xlUp))
            Set Art = Worksheets("Articles").Columns(4).Find(Cel.Value, , xlValues, xlWhole)
            If Not Art Is Nothing Then
                Msg = Msg & "La cellule correspondant à " & Cel.Value & " contient " & Art.Offset(, 1) & Chr(10)
            End If
        Next Cel
        MsgBox Msg
    End With
End Sub


A+
0

Discussions similaires

Reporter valeur sur autre feuille avec critere
Otk168 -
via55 -

4 réponses
Reporter des données d'une feuille dans une autre feuille
55ExcelPro -
PHILOU10120 -

1 réponse