Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Recherche en vba

ingel

XLDnaute Nouveau
Bonsoir à tous,

Je voudrai faire une recherche en VBA afin d'affecter la valeur d'une cellule sur autre feuille;
j'ai pu avancer avec ce petit bout de code :
Code:
Sub memoire()
Dim mem As Variant
For mem = 3 To ActiveWorkbook.Sheets.Count
If Sheets(mem).Name = Sheets(" Recap").Cells(mem, 1) Then
Sheets(mem).[K15].Value = Sheets(" Recap").Cells(mem, 2).Value
End If
 Next mem
 end Sub

Par contre j'ai un souci avec les ligne vides, ou quand il y a un décalage dans ma colonne, cela me renvoi rien alors que les valeurs existe bien dans ma table.

Quelqu'un pourrait m'aider svp

Merci
 

ingel

XLDnaute Nouveau
Re : Recherche en vba

Bonsoir,
j'ai joint un petit model
pour etre plus clair, la recherche que je veut faire c'est une recherche sur toute la colonne A et non pas juste la cellule (mem,1)

Merci
 

Pièces jointes

  • test.xlsm
    16.6 KB · Affichages: 49
  • test.xlsm
    16.6 KB · Affichages: 56
  • test.xlsm
    16.6 KB · Affichages: 57

camarchepas

XLDnaute Barbatruc
Re : Recherche en vba

Re ,

Voici la solution proposée :
Code:
Sub memoire()
Dim Cellule  As Range
Dim LigneFin As Long
LigneFin = Sheets(" Recap").Range("A" & Rows.Count).End(xlUp).Row
For Each Cellule In Sheets(" Recap").Range("A3:A" & LigneFin)
 If Cellule <> "" Then Sheets(Cellule.Value).[K15] = Cellule.Offset(0, 1).Value
Next
  
End Sub
 

ingel

XLDnaute Nouveau
Re : Recherche en vba

bonsoir,
c'est encore moi,
au fait j'ai rencontré un souci avec le code plus haut, en effet si par exemple un produit existe dans la recap mais pas de feuille correspondante, la macro bug
Merci
 

camarchepas

XLDnaute Barbatruc
Re : Recherche en vba

Bonjour ,

Donc suite au nouveau cahier des charges :

Code:
Sub memoire()
 Dim Cellule  As Range
 Dim LigneFin As Long
 LigneFin = Sheets(" Recap").Range("A" & Rows.Count).End(xlUp).Row
 For Each Cellule In Sheets(" Recap").Range("A3:A" & LigneFin)
  If Cellule <> "" Then
    On Error Resume Next
    Sheets(Cellule.Value).[K15] = Cellule.Offset(0, 1).Value
    If Err.Number = 9 Then
       ThisWorkbook.Worksheets.Add
       ActiveSheet.Name = Cellule.Value
       Sheets(Cellule.Value).[K15] = Cellule.Offset(0, 1).Value
       
    End If
    On Error GoTo 0
  End If
 Next
   
End Sub
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…