XL 2010 Modif code recherche

Leclerc Jean · 24 Janvier 2017

Bonjour la liste,

Je cherche à modifier un code pour pouvoir utiliser des valeurs comme critères de recherche

Cas 1 : si une valeur apparaît dans la cellule B2 le code s'exécute pour rechercher sur une autre feuille la ligne sur laquelle on retrouve la même valeur en colonne B (recherche sur toutes les lignes).

Code:

Sub RCher()
With Sheets("InterX")
        For i = .Range("B65536").End(xlUp).Row To 2 Step -1
            If .Range("B" & i).Value = Sheets("REC").Range( "b2").Value Then
            .Rows(i).Copy Destination:=Sheets("REC").Range("A2")
            End If
        Next i
    End With

Cas 2 : Comment modifier le code ci-dessus si :
la cellule B2 est vide, et
si impérativement C2 et F2, ne le sont pas
afin de recopier la ligne de la feuille InterX où l'on trouve sur la même ligne :
l'équivalent de ce que contiennent C2 et F2

(J'ai essayé plusieurs rédactions de code sans succès)

Merci pour votre aide.

Lone-wolf · 25 Janvier 2017

Bonjour Jean et bienvenue sur XLD 🙂

Un essai

VB:

Option Explicit
Sub test()
Dim plage As Range, cel As Range
With Sheets(1)
 Set plage = .Range("b2:f" & .Range("f" & Rows.Count).End(xlUp).Row)
  For Each cel In plage
  If Not IsEmpty(cel.Offset(0, 0)) And cel.Offset(0, 1) <> "" Or cel.Offset(0, 4) <> "" Then
  .Cells(cel.Row, 2).Copy Sheets(2).Range("a65536").End(xlUp)(2)
  .Range(.Cells(cel.Row, 3), .Cells(cel.Row, 6)).Copy Sheets(2).Range("b65536").End(xlUp)(2)
  End If
  Next cel
End With
End Sub

Leclerc Jean · 26 Janvier 2017

Lone-wolf à dit:

Bonjour Jean et bienvenue sur XLD 🙂

Un essai

VB:

Option Explicit
Sub test()
Dim plage As Range, cel As Range
With Sheets(1)
Set plage = .Range("b2:f" & .Range("f" & Rows.Count).End(xlUp).Row)
  For Each cel In plage
  If Not IsEmpty(cel.Offset(0, 0)) And cel.Offset(0, 1) <> "" Or cel.Offset(0, 4) <> "" Then
  .Cells(cel.Row, 2).Copy Sheets(2).Range("a65536").End(xlUp)(2)
  .Range(.Cells(cel.Row, 3), .Cells(cel.Row, 6)).Copy Sheets(2).Range("b65536").End(xlUp)(2)
  End If
  Next cel
End With
End Sub

Merci beaucoup ça fonctionne très bien

XL 2010 Modif code recherche

Leclerc Jean

XLDnaute Nouveau

Lone-wolf

XLDnaute Barbatruc

Leclerc Jean

XLDnaute Nouveau

Discussions similaires

XL 2010 Modif code recherche

Leclerc Jean

XLDnaute Nouveau

Lone-wolf

XLDnaute Barbatruc

Leclerc Jean

XLDnaute Nouveau

Discussions similaires

Privacy & Transparency

Privacy & Transparency