VBA copier/coller sous conditions

melcame Messages postés 7 Statut Membre -  
melcame Messages postés 7 Statut Membre -
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

1 réponse

  1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   Ambassadeur 1 588
     
    bonjour, peux-tu partager ton code, en utilisant la coloration syntaxique?
    0
    1. melcame Messages postés 7 Statut Membre
       
      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
    2. melcame Messages postés 7 Statut Membre
       
      Bonjour yg_be,

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

      Bonne fin de semaine
      0