VBA copie cellules sous conditions Fermé

Question

Bonjour,
Je suis secrétaire d'un petit club de bad et j'ai un tableau regroupant tous les inscrits pour un tournoi...
J'aimerai dispatcher ces infos dans differentes feuilles (du même classeur)... Dans exactement 27 feuilles (ben oui)...
Pour ajouter 27 feuilles à mon classeur, leur donner un format avec ligne en-tête et compagnie, ça va, tout marche mais c'est les histoires de conditions... J'explique : il me faudrait

Dans "feuilParis", lister ligne par ligne en commençant par la ligne 2 puis en descendant
si valeur colonne F=H et si valeur colonne K=B- alors recopie des cellules en colonne B-C-D-K dans "feuil SHB-" en partant de la ligne 2 et ainsi de suite jusqu'à la dernière ligne (nombre indeterminé)

J'ai essayé qqs trucs mais je ne suis pas du tout une spécialiste en VBA, je n'en suis qu'aux prémisses...
Quelqu'un peut-il m'aider?
Merci d'avance

Ivan-hoe · Accepted Answer

Bonsoir Cricri, 
il y a de bonnes idées dans ce que tu as écrit, mais tout ne me semble pas toujours dans le bon ordre
Je te propose de t'inspirer de la petite procédure ci-dessous, qui suit le schéma suivant : 
- sélection de la feuille "à lire" ("Paris")
- lecture de chaque ligne, tant que la cellule A n'est pas vide
- si la ligne répond aux deux conditions, alors écriture des données des colonnes C-D-B et K dans la feuille "à écrire" ("SHB-"), sans l'activer

A toi de jouer ! 


Dim DerniereLigne As Long 'dans la feuille à écrire
Dim LigneActive As Long 'dans la feuille à lire

Sub Procedure()

Sheets("Paris").Select
Range("A2").Select

While ActiveCell.Value <> Empty
LigneActive = ActiveCell.Row 'n° de la ligne "à lire"
If Cells(LigneActive, 6).Value = "H" And Cells(LigneActive, 11).Value = "B-" Then

'écriture dans la feuille "SHB-"
With Sheets("SHB-")
    DerniereLigne = .Range("A65536").End(xlUp).Offset(1, 0).Row 'n° de la ligne "à écrire"
    .Cells(DerniereLigne, 1).Value = Cells(LigneActive, 3).Value 'écrit dans la 1ère colonne la valeur trouvée dans la colonne C
    .Cells(DerniereLigne, 2).Value = Cells(LigneActive, 4).Value ' écrit dans la 2è colonne la valeur trouvée dans la colonne D
    .Cells(DerniereLigne, 3).Value = Cells(LigneActive, 2).Value ' écrit dans la 3è colonne la valeur trouvée dans la colonne B
    .Cells(DerniereLigne, 4).Value = Cells(LigneActive, 11).Value 'écrit dans la 4è colonne la valeur trouvée dans la colonne K
End With

End If
ActiveCell.Offset(1, 0).Activate

Wend
End Sub

Ivanhoe · Answer

Bonjour Cricri, 
Ah ! les joies du bénévolat en milieu associatif, qui te fait bosser un dimanche soir sur un %##! de fichier à 27 feuilles ! 
Difficile de donner une réponse précise sans avoir l'obje sous les yeux, mais voici quelques pistes (je ne suis pas non plus spécialiste, ce ne sont que des suggestions ) : 

Pour descendre une à une toutes les lignes de ton tableau, il te faudra une boucle
par exemple : la boucle s'effectue jusqu'à ce qu'on arrive à une cellule vide (en fait, tant que (while)  la cellule active n'est pas vide)

While Activecell.value <> empty
[.....]
[.....]

Activecell.offset(1,0).activate 'activer la cellule suivante vers le bas
Wend

Pour faire tes tests, il te faut une condition si...alors (if... then)
If Cells (activecell.row,6)  = "H" And Cells(activecell.row,11) = "B-" then 
[...]
End If
J'utilise ici une des nombreuses façons d'identifier une cellule : Cells(n° ligne, n° colonne), avec ici n° ligne qui est activecell.row (n° de la ligne de la cellule active) et n° colonne = 6 pour la colonne F et 11 pour la colonne K

Pour aller écrire à la fin de ta feuille "SHB-", on peut essayer qqch comme : 
Sheets ("SHB-").range("A1").end(xldown).offset(1,0)
ce qui se traduit par : 
dans la feuille ("SHB-"), à partir de la cellule A1, aller jusqu'à la dernière valeur trouvée vers le bas (end(xldown)) et passer à la ligne suivante (offset(1,0) décale d'une ligne vers le bas et de 0 colonne, c'est à dire passe à la ligne suivante)

Bon courage ! N'hésite pas à consulter l'aide en ligne de l'éditeur VBA, c'est trèsinstructif !

cricri94 · Answer

Bon, j'en suis là, donc un peu nulle part...

Dim Lig     As Long
  Dim Col     As String
  Dim NbrLig  As Long
  Dim NumLig  As Long

  Sheets("Paris").Select
  For Each Ligne In Sheets("Paris")
 Sheets("SHB-").Activate ' feuille de destination
   NumLig = 2          'N° de la 1er ligne de données
 With Sheets("Paris")     ' feuille source'
  NbrLig = .Cells(65536, Col).End(xlUp).Row
     End With

    If Cells(ActiveCell.Row, 6).Value = "B-" Then
    If Cells(ActiveCell.Row, 11).Value = "H" Then
      Cells(Lig, Col).Column("C", "D", "B", "K").Copy
      NumLig = NumLig + 1
      Sheets("SHB-").Cells(NumLig, 1).Insert Shift:=xlDown
            'ici pour insérer ou  .Paste pour coller'
    End If
  MsgBox ("C'est fini !!")
  
  End Sub

cricri94 · Answer

C'est super !! ça marche !! Sauf que... les valeurs sont doublées cad que mes résultats sont copiés deux fois dans la feuille de destination (SHB-)... Je vais essayer de trouver où ça coince... Ou ce serait abuser de demander si tu as encore une idée...
En tout cas, vraiment merci beaucoup...

cricri94 · Answer

Rectification, ça marche très bien...
La 1ère fois, effectivement, les résultats étaient doublés mais je viens de réessayer depuis le début et c'est IMPECCABLE!!

Merci beaucoup beaucoup...
A bientôt,
Cricri

blue007 · Answer

Bonjour cricri94, 

Donc je ne sais pas si vous êtes toujours inscris sur ce forum, mais j'ai besoin de vos conseils, j'ai appliqué ton algo sur une table que j'utilise et sa marche nikel mais le problème il ne parcoure pas ligne pas ligne, en gros il fait la 1er ligne et il s'arrête. 

Vous avez une solution ? 

Merci

VBA copie cellules sous conditions

6 réponses

Discussions similaires