VBA copier/coller sous conditions

Fermé
melcame Messages postés 5 Date d'inscription vendredi 22 février 2019 Statut Membre Dernière intervention 4 mars 2019 - 22 févr. 2019 à 22:45
melcame Messages postés 5 Date d'inscription vendredi 22 février 2019 Statut Membre Dernière intervention 4 mars 2019 - 1 mars 2019 à 22:29
Bonjour,

Je cherche à créer une VBA qui dans la feuille "Client1", cherche dans la colonne B le nom de la zone ("Découpe 1", "Découpe 2", "Cuisine") et copie les cellules de la même ligne seulement pour les colonnes C à F. Les cellules copiées seraient collées dans 3 feuilles différentes "Découpe1", "Découpe2", "Cuisine" en fonction de la zone indiquée de la colonne B.

1. J´ai trouvé un code pour le copier/coller ("CopierCondition") mais j´aimerais améliorer la mise en forme du résultat obtenu :
- ne pas coller la mise en forme du tableau (bordure) mais seulement coller les valeurs
- supprimer les cellules vides.

1. Question : Si je fais "Combiner et centrer" les cellules de la colonne B par zone existe-il un moyen d´adapter le code pour que toutes les cellules des colonnes C à F situées sur le niveau de la zone soient copiées? En effet, avec le code actuel, seule une ligne est copiée.

3. Dans un deuxième temps, j´aimerais que la macro puisse chercher dans une autre feuille "Programme" les clients pogrammés chaque jour, et remplisse dans les feuilles "Découpe1", Découpe2" et "Cuisine" les activités à réaliser.

Pourriez-vous m´éclairer s´il vous plait, surtout pour les points 1 et 2?

Merci d´avance pour votre aide,

Bon week end
A voir également:

1 réponse

yg_be Messages postés 23476 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 20 février 2025 Ambassadeur 1 568
23 févr. 2019 à 11:12
bonjour, peux-tu partager ton code, en utilisant la coloration syntaxique?
0
melcame Messages postés 5 Date d'inscription vendredi 22 février 2019 Statut Membre Dernière intervention 4 mars 2019
25 févr. 2019 à 15:12
Bonjour,

Excusez-moi pour ma réponse tardive. Voici le code :
Sub CopierCondition()

Dim Rw As Range
Dim Ligne As Long

' Sélection de l´ensemble des données

Sheets("Client1").Select
ActiveCell.SpecialCells(xlLastCell).Select
Range(Selection, Cells(1)).Select

' Boucle qui cherche sur chaque ligne le mot voulu et copie dans une deuxième feuille de calcul

For Each Rw In Selection.Rows

Ligne = Rw.Row

If Rw.Cells(1, 2).Value = "Découpe 1" Then
Rw.Copy Destination:=Worksheets("Découpe1").Cells(Ligne, 1).EntireRow

End If
    
Next Rw

Dim Cellule As Range
    For Each Cellule In Sheets("Découpe1").Range("C3:F10")
        If Cellule Is Nothing Or Cellule.Value = "" Then
            Cellule.Delete xlUp
        End If
    Next Cellule

For Each Rw In Selection.Rows

Ligne = Rw.Row

If Rw.Cells(1, 2).Value = "Découpe 2" Then
Rw.Copy Destination:=Worksheets("Découpe2").Cells(Ligne, 1).EntireRow
End If

Next Rw


For Each Rw In Selection.Rows

Ligne = Rw.Row

If Rw.Cells(1, 2).Value = "Cuisine" Then
Rw.Copy Destination:=Worksheets("Cuisine").Cells(Ligne, 1).EntireRow
End If

Next Rw

End Sub

0
melcame Messages postés 5 Date d'inscription vendredi 22 février 2019 Statut Membre Dernière intervention 4 mars 2019
1 mars 2019 à 22:29
Bonjour yg_be,

Pourriez-vous me donner quelques conseils s´il vous plait?

Bonne fin de semaine
0