Copier des cellules sous condition

Vinvol

XLDnaute Junior
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é :

Code:
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
 

Pièces jointes

  • Book1.xlsm
    20.5 KB · Affichages: 51
  • Book1.xlsm
    20.5 KB · Affichages: 50
  • Book1.xlsm
    20.5 KB · Affichages: 45

youky(BJ)

XLDnaute Barbatruc
Re : Copier des cellules sous condition

Salut vinvol,
La macro ira mieux ainsi..
Bruno

Code:
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

XLDnaute Junior
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

XLDnaute Junior
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)

XLDnaute Barbatruc
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)

XLDnaute Barbatruc
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

XLDnaute Junior
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
 

Pièces jointes

  • Outil.xlsm
    25 KB · Affichages: 38
  • Index.xls
    23.5 KB · Affichages: 39
  • Index.xls
    23.5 KB · Affichages: 42
  • Index.xls
    23.5 KB · Affichages: 44

youky(BJ)

XLDnaute Barbatruc
Re : Copier des cellules sous condition

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

Code:
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

XLDnaute Junior
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
 

Discussions similaires

Statistiques des forums

Discussions
312 875
Messages
2 093 148
Membres
105 641
dernier inscrit
Naoel