Discussion :

[martinigi]

Bonjour,
Je cherche à sélectionner toutes les cellules des colonnes H:K en fonction de la valeur insrcite colonne A.

Voici le code que j'ai fait mais qui ne fonctionne pas.
Si quelqu'un peut m'aider?

Merci beaucoup de votre aide.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub RechercheSelect()
Dim R As Range
Dim C As Range
Dim var
 
Range("A:A").Select
var = 1249
 
If IsNumeric(var) Then var = CDbl(var)
For Each C In Selection
  If C = var Then
    If R Is Nothing Then
      Set R = C
    Else
      Set R = Application.Union(R, C)
    End If
  End If
Next C
If Not R Is Nothing Then
  R.Select
'Selection(, 8).Resize(, 4).Select (Ca ne marche pas)
Else
  MsgBox "Aucun bon d'achat N°" & var & " n'a été trouvée"
End If
End Sub

[martinigi]

Bonjour,
Je cherche à sélectionner toutes les cellules des colonnes H:K en fonction de la valeur insrcite colonne A.

Voici le code que j'ai fait mais qui ne fonctionne pas.
Si quelqu'un peut m'aider?

Merci beaucoup de votre aide.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub RechercheSelect()
Dim R As Range
Dim C As Range
Dim var
 
Range("A:A").Select
var = 1249
 
If IsNumeric(var) Then var = CDbl(var)
For Each C In Selection
If C = var Then
If R Is Nothing Then
Set R = C
Else
Set R = Application.Union(R, C)
End If
End If
Next C
If Not R Is Nothing Then
R.Select
'Selection(, 8).Resize(, 4).Select (Ca ne marche pas)
Else
MsgBox "Aucun bon d'achat N°" & var & " n'a été trouvée"
End If
End Sub

[halaster08]

Bonjour,

Pourquoi ne pas simplement utiliser un filtre sur la colonne A ?

[martinigi]

Je doit ensuite copier coller les valeurs dans un autre tableau. Si je fait un filtre, ça me sélectionne les cellules filtrés aussi.

[halaster08]

Normalement le copier/coller ignore les cellules filtrées, puis-je voir ton code de copie/collage ?

Tu peux aussi je ter un œil à ce tuto https://philippetulliez.developpez.c...dvancedfilter/, tu peux filtrer et copier en même temps.

[martinigi]

Bonjour,
En effet ça marche avec le filtre je n'avais pas fait attention, mais là ou j'ai un problème avec cette méthode c'est que je ne veux copier que les lignes comportant des données. Dans mon code ça me copie toute les lignes vides apres le filtres :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub Macro1()
 
    Sheets("Base de donnée").Select
    ActiveSheet.Range("$A$1:$O$500").AutoFilter Field:=1, Criteria1:="1249"
    Range("H28:K500").Copy
    Sheets("Bon de commande").Select
    Range("I17").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("J25").Select
End Sub

[Invité]

Bonjour,

Une version une peu modifiée de votre code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
 
Option Explicit
 
Public R As Range
 
Sub RechercheSelect(ByVal FeuilleBonAchat As Worksheet, TitreFeuille As Long, ByVal NumeroBonAchat As Variant)
Dim AireBonAchat As Range
Dim C As Range
Dim DerniereLigne As Long
 
    Application.ScreenUpdating = False
    With FeuilleBonAchat
         DerniereLigne = .Cells(.Rows.Count, 1).End(xlUp).Row
         Set AireBonAchat = .Range(.Cells(TitreFeuille + 1, 1), .Cells(DerniereLigne, 1))
         For Each C In AireBonAchat
             If C = NumeroBonAchat Then
                If R Is Nothing Then
                  Set R = Range(C.Offset(0, 7), C.Offset(0, 10))
                Else
                  Set R = Application.Union(R, Range(C.Offset(0, 7), C.Offset(0, 10)))
                End If
             End If
         Next C
         Set AireBonAchat = Nothing
    End With
    Application.ScreenUpdating = True
 
End Sub

Dans le module de Feuil1

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
 
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
    If Target.Count > 1 Then Exit Sub
 
    If Not Intersect(Target, Range("CelluleBonAchat")) Is Nothing Then
 
       RechercheSelect ActiveSheet, 10, Target
 
       With Range("ResultatCelluleBonAchat")
            If Not R Is Nothing Then
               R.Select
               .Value = R.Address
            Else
              .Value = "Aucun bon d'achat N°" & Range("CelluleBonAchat") & " n'a été trouvé."
            End If
        End With
 
        Set R = Nothing
 
    End If
 
End Sub

Nb : Je me suis peut-être emmêlé les pinceaux entre bon d'achat et numéro de commande...

Pièce jointe 406401

[RyuAutodidacte]

Bonjour,

@Patrick bien vu moi j'étais sur ce poste et je n'avais pas vu l'autre

Bon pour ne pas mettre à la poubelle ce que j'ai commencé (code à adapter bien sur …) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub GetRange()
Dim Entete_Debut As Byte, Crit, Trouve&, F As Boolean, R As Range
 
Entete_Debut = 1 ' chiffre variable  pour retirer l'en-tête ou commencé à un ligne précise
Crit = Application.InputBox("Recherche :", "RECHERCHE BON ACHAT")
Application.ScreenUpdating = False
With ActiveSheet
If Not .AutoFilter Is Nothing Then F = True
    With .Cells(1).CurrentRegion
    Trouve = Application.CountIf(.Columns.Item(1), Crit)
        If Trouve > 0 And Crit > "" Then
            .AutoFilter Field:=1, Criteria1:=Crit
            Set R = .Offset(Entete_Debut, 7).Resize(.Rows.Count - Entete_Debut, 4).SpecialCells(xlCellTypeVisible)
            R.Copy:  Sheets("Bon de commande").Range("I" & Feuil2.Cells(Rows.Count, "I").End(xlUp)(2).Row).PasteSpecial xlPasteValues
        Else
            MsgBox "Aucun bon d'achat N°" & Crit & " n'a été trouvée"
        End If
    If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData
    If Crit > "" And Trouve > 0 And F = False Then .AutoFilter
    End With
End With
Application.ScreenUpdating = True
Set R = Nothing
End Sub