Copier des cellules sous condition

[Vinvol]

Bonjour,

Dans une colonne, j'ai une liste de valeurs et je voudrais en copier certaine. Pour ne pas me perdre longuement en explication, voici le code que j'ai bricolé :

Private Sub CommandButton1_Click()

Dim i As Integer
Dim Dest As Range

For i = 1 To 20

If Sheets("Sheet1").Cells(i, 1).Value Like "*RAPID*" Then
Set Dest = Sheets("Sheet2").Range("A1:A" & Sheets("Sheet2").Range("A65000").End(xlUp).Row + 1)
Sheets("Sheet1").Cells(i, 1).Copy Destination:=Dest
End If

Next i

End Sub

Evidemment, si je viens sur le forum, c'est qu'il ne marche pas. Il ne copie que la dernière valeur identifiée et non pas toutes, l'une après l'autre, comme je l'aurais souhaité.

Pouvez-vous m'aider à comprendre ce qui ne va pas dans ce code ?

PS. Si la destination peut avoir l'air un peu barbare, c'est que cette macro va tourner dans une boucle qui activera l'une après l'autre toutes les feuilles d'un classeur (en remplaçant sheets("#") par Activesheets.

Merci,
Vincent

 

[youky(BJ)]

Re : Copier des cellules sous condition

Salut vinvol,
La macro ira mieux ainsi..
Bruno

Private Sub CommandButton1_Click()
Dim i As Integer
Dim lig As Long
With Sheet2 'Sheet2 est le codeName et non le nom de la feuille
    lig = .Range("A1:A" & .Range("A65000").End(xlUp).Row) + 1
  For i = 1 To 20
    If Sheets("Sheet1").Cells(i, 1).Value Like "*RAPID*" Then _
        .Cells(lig, 1) = Cells(i, 1): lig = lig + 1
  Next i
End With
End Sub

 

[Vinvol]

Re : Copier des cellules sous condition

Bonjour Bruno,

C'est là que je vois que je bricole plus que j'y connais grand chose... c'est quoi un codeName ?
Je préfère demander parce que, comme dans le code finale, ça se fera entre 2 classeurs...

En tout cas, merci beaucoup, ça fonctionne a merveille !

Vincent

 

[Vinvol]

Re : Copier des cellules sous condition

Re-bonjour,

Je viens de le tester en "situation" réelle et, ça fonctionne pour la première feuille, mais dès qu'il passe à la seconde, ça bug sur lig = .Range("A1:A" & .Range("A65000").End(xlUp).Row) + 1

Une idée ?

Merci,
Vincent

 

[youky(BJ)]

Re : Copier des cellules sous condition

Re:
Le codename...
Est le nom réelle de la feuille que tu peux voir en VBA en fenêtre projet (en principe à gauche)
Exemple Sheet1(Sheet1)
Si tu renommes cet onglet en "toto" cela deviens
Sheet1(toto)
Pour éviter les PB je préfère donc utiliser ce codename cela permet à la macro de retouver la feuille mm si elle a été renommée
Bruno

 

[youky(BJ)]

Re : Copier des cellules sous condition

Re;
Plusieurs feuilles ....Ha bon !
C'était pas prévu dans la macro.
Combien de feuilles? se suivent'elles ?comment les reconnaitre?
Bon un exemple avec les onglets même sans données est indispensable.
Bruno

 

[Vinvol]

Re : Copier des cellules sous condition

Autant pour moi, je n'ai pas anticipé que l'enchainement de feuilles puisse avoir une incidence sur la macro (quoi que mon PS y faisait allusion).

Alors ci-joint deux fichiers :
Index : fichier source où se trouve les données à récupérer
Outil : fichier réceptacle qui contient la macro.

Le nombre de feuilles dans le fichier Index est amené à varié. La macro que j'utilise pour passer de l'une à l'autre semble fonctionner... (c'est celle qui est liée au bouton)

C'est un exemple réduit (très réduit) mais qui se rapproche de la réalité (à savoir que dans l'index, il y a des lignes vides, comme dans cet exemple. D'où le "contient *RAPID*"

Merci,
Vincent

 

[youky(BJ)]

Re : Copier des cellules sous condition

Voici la modification et testée.
Les 2 fichiers doivent être ouvert.
Bruno

Sub Import()
Dim i As Integer
Dim lig As Long
Dim onglet As Integer
Set X = Workbooks("Outil.xlsm").Sheets("Sheet1")
Set Y = Workbooks("Index.xls")
lig = X.[B65536].End(3).Row
For onglet = 1 To Y.Sheets.Count
  For i = 1 To Y.Sheets(onglet).Range("A65000").End(xlUp).Row
    If Y.Sheets(onglet).Cells(i, 1).Value Like "*RAPID*" Then _
        X.Cells(lig, 2) = Y.Sheets(onglet).Cells(i, 1): lig = lig + 1
  Next i
Next
End Sub

 

[Vinvol]

Re : Copier des cellules sous condition

Alors là... un grand BRAVO !!!

Ca me confirme que je ne l'aurais pas trouvé tout seul mais je vais décortiquer tout ça pour comprendre le principe.

Merci beaucoup Bruno pour le temps que tu as passé sur ce code.

Vincent