XL 2010 Copier coller lignes avec condition.

DAVID-44-

XLDnaute Occasionnel
Bonjour,
Je fais un copier/coller automatique des lignes d'une feuille "MISE EN PLACE" dans la feuille "MISE EN PLACE POUR FICHE" à l'aide de la formule :
=SI(F2="EN";LIGNE()-1;"") dans la première feuille "MISE EN PLACE" et :
=SIERREUR(INDEX('MISE EN PLACE'!A$2:A$41;PETITE.VALEUR('MISE EN PLACE'!$G$2:$G$41;LIGNES(1:1)));"") dans la feuille "MISE EN PLACE POUR FICHE".
Pour la première partie les formules fonctionnent dans "MISE EN PLACE" de la ligne A2 / E20 pour les copier dans "MISE EN PLACE POUR FICHE" de la ligne A2 / E20.
Par contre je galère pour la suite.
En utilisant les mêmes formules en modifiant les plages de sélections ça ne marche pas :
=SI(F43="EN1";LIGNE()-1;"") dans la première feuille "MISE EN PLACE" et :
=SIERREUR(INDEX('MISE EN PLACE'!A$43:A$82;PETITE.VALEUR('MISE EN PLACE'!$G$43:$G$82;LIGNES($1:26)));"") dans la feuille "MISE EN PLACE POUR FICHE".
J'ai essayé plusieurs modifications, mais rien ne fonctionne pour la deuxième partie.
Aussi, j'aimerais savoir, s'il est possible de faire une formule de ce type (ou un autre moyen/formule) :
=SI(F2="EN""PL""DS";LIGNE()-1;"") afin de pouvoir copier les lignes, A21 a E25 de la première feuille "MISE EN PLACE" dans les lignes A44 a E48 de la feuille "MISE EN PLACE POUR FICHE".
Merci de votre aide.
Bonne journée.
Cordialement.
David.
 

Pièces jointes

  • MENU - DAVID..xls
    90 KB · Affichages: 22

Rouge

XLDnaute Impliqué
Donc ce n'est pas un problème de version, je renvoie le premier fichier avec l'extension ".XLSM" mais j'ai retiré un motif qui contenait le message suivant:
"Très important, mettre EN, EN1, EN2, etc en première ligne de chaque jour"

Sinon recopiez le code suivant dans un fichier qui s'ouvre
VB:
Sub Recup_Valeurs()
    Dim f1 As Worksheet, f2 As Worksheet
    Dim DerLig_f1 As Long, DerLig_f2 As Long
    Dim i As Long
    Application.ScreenUpdating = False
    Set f1 = Sheets("MISE EN PLACE")
    Set f2 = Sheets("MISE EN PLACE POUR FICHE")
    f2.Cells.Clear
    f2.Cells.UnMerge
    DerLig_f1 = f1.Range("A" & Rows.Count).End(xlUp).Row
    f1.Range("A1:F" & DerLig_f1).Copy f2.Range("A1")
    
    'Suppression des lignes vides
    For i = DerLig_f1 To 2 Step -1
        If f2.Cells(i, "A") = "" Or f2.Cells(i, "A") = 0 Then f2.Rows(i).Delete
    Next i
    
    DerLig_f2 = f2.Range("A" & Rows.Count).End(xlUp).Row
    'insertion d'une ligne vide nentre différent type de plat
    For i = DerLig_f2 To 2 Step -1
        If f2.Cells(i, "F") <> f2.Cells(i - 1, "F") And f2.Cells(i, "A").Interior.Color <> RGB(255, 0, 0) Then f2.Rows(i).Insert Shift:=xlDown
    Next i
    'Recopie du jour dans chaque séparation des différents types de plat
    DerLig_f2 = f2.Range("A" & Rows.Count).End(xlUp).Row
    Jour = f2.Cells(i, "A")
    repas = f2.Cells(i, "B")
    For i = 2 To DerLig_f2
        If f2.Cells(i, "A").Interior.Color = RGB(255, 0, 0) Then
            Jour = f2.Cells(i, "A")
            repas = f2.Cells(i, "B")
        End If
        If f2.Cells(i, "A") = "" Then
            Range(f2.Cells(i, "A"), f2.Cells(i, "B")) = Array(Jour, repas)
            With Range(f2.Cells(i, "A"), f2.Cells(i, "B"))
                .Interior.Color = RGB(255, 0, 0)
                .Font.Color = RGB(255, 255, 255)
            End With
            Range(f2.Cells(i, "B"), f2.Cells(i, "C")).MergeCells = True
            With Range(f2.Cells(i, "B"), f2.Cells(i, "C"))
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With
        End If
    Next i
    
    'insertion d'une ligne vide entre chaque jour et par repas
    For i = DerLig_f2 To 2 Step -1
        If f2.Cells(i, "A").Interior.Color = RGB(255, 0, 0) Then
            f2.Rows(i).Insert Shift:=xlDown
        End If
    Next i
  
    DerLig_f2 = f2.Range("A" & Rows.Count).End(xlUp).Row
    f2.Range("A1:F" & DerLig_f2).Borders().Weight = xlMedium
    f2.Columns("A:F").EntireColumn.AutoFit

    f2.Select
    Set f1 = Nothing
    Set f2 = Nothing
End Sub
 

Pièces jointes

  • DAVID-44-_Copier coller lignes avec condition_2.1.xlsm
    49.8 KB · Affichages: 4

DAVID-44-

XLDnaute Occasionnel
Bonjour,
Est-il possible de classé la feuille "MISE EN PLACE POUR FICHE" par tous les EN - EN1 - EN2 .... à la suite et faire pareil pour les "PL" et les "DS" comme dans "MISE EN PLACE POUR FICHE" dans le classeur exemple ?
Merci de votre aide.
Cordialement.
Bonne journée.
David.
 

Pièces jointes

  • DAVID-44-_Copier coller EXEMPLE.xlsm
    45.1 KB · Affichages: 5

Discussions similaires