XL 2016 [RESOLU] Consolidation de feuilles selon plusieurs règles

[ivan27]

Bonjour à tous,

Je viens vous soumettre un problème de consolidation d'onglets
En pièce jointe un classeur comprenant :

- Un onglet par jour avec comme nom, la date du jour.
- Un onglet BD dans lequel je souhaite consolider tous les autres onglets

Consolidation souhaitée :

Si sur la ligne d'un salarié j'ai au moins un chiffre 1 et que le service est différent de 'S1' alors je récupère les colonnes "A:E" du salarié, j'additionne les ''1'' en colonne "F" et je récupère le nom de l'onglet en colonne "G".

Si sur la ligne d'un salarié j'ai au moins un chiffre 1 et que le service est 'S1' alors je récupère les colonnes "A:E" du salarié; à chaque fois que j'ai un chiffre 1 sur la ligne, je récupère l'heure correspondante en colonne "F" et je récupère le nom de l'onglet en colonne "G".

Bonne journée et merci d'avance pour votre aide,

Ivan

 

[camarchepas]

Bonjour Ivan,

A mettre dans un module standard.

Puis exécuter

Option Explicit

Sub Consolide()
'Consolidation des onglets Jours dans la base BD selon le traitement conditionnel prévu
'Camarchepas pour Ivan le 25/04/2019
 Dim Tourne As Long, Fin_Ligne As Long, Ligne_Cible As Long, Colonne As Long
 Dim Onglet As Worksheet
 Dim Nom_Onglet As String
 
'Boucle de balayage jour
 For Each Onglet In ThisWorkbook.Worksheets
  'Ne pas traiter l'onglet BD
   If Onglet.Name <> "BD" Then
    'Détection de la dernière ligne onglet jour
     Fin_Ligne = Onglet.Range("A" & Rows.Count).End(xlUp).Row
    
    'Boucle de lecture des lignes
     For Tourne = 2 To Fin_Ligne
          'Si le service est différent de 'S1' alors
           If Onglet.Range("C" & Tourne) <> "S1" Then
             'Si sur la ligne d'un salarié j'ai au moins un chiffre 1 alors
              If Onglet.Range("BB" & Tourne).Value > 0 Then
                 'Détecte la ligne cible dans BD
                  Ligne_Cible = Worksheets("BD").Range("A" & Rows.Count).End(xlUp).Row + 1
                 'je récupère les colonnes "A:E" du salarié,
                  Worksheets("BD").Range("A" & Ligne_Cible & ":E" & Ligne_Cible) = Onglet.Range("A" & Tourne & ":E" & Tourne).Value
                 'et je récupère le nom de l'onglet en colonne "G".
                  Worksheets("BD").Range("G" & Ligne_Cible) = CDate(Onglet.Name)
                 'j'additionne les ''1'' en colonne "F"
                  Worksheets("BD").Range("F" & Ligne_Cible) = Onglet.Range("BB" & Tourne).Value
              'Fin du Si sur la ligne d'un salarié j'ai au moins un chiffre 1
               End If
              
            'Sinon ('le service est 'S1')
             Else
              
              'Si sur la ligne d'un salarié j'ai au moins un chiffre 1 alors
               If Onglet.Range("BB" & Tourne).Value > 0 Then
                'à chaque fois que j'ai un chiffre 1 sur la ligne,
                For Colonne = 0 To 47
                 If Onglet.Range("F" & Tourne).Offset(0, Colonne) = "1" Then
                  'Détecte la ligne cible dans BD
                   Ligne_Cible = Worksheets("BD").Range("A" & Rows.Count).End(xlUp).Row + 1
                  'je récupère les colonnes "A:E" du salarié,
                   Worksheets("BD").Range("A" & Ligne_Cible & ":E" & Ligne_Cible) = Onglet.Range("A" & Tourne & ":E" & Tourne).Value
                  'et je récupère le nom de l'onglet en colonne "G".
                   Worksheets("BD").Range("G" & Ligne_Cible) = CDate(Onglet.Name)
                  ' je récupère l'heure correspondante en colonne "F"
                   Worksheets("BD").Range("F" & Ligne_Cible) = Onglet.Range("F" & 1).Offset(0, Colonne)
                   Worksheets("BD").Range("F" & Ligne_Cible).NumberFormat = "hh:mm"
                 End If
                Next Colonne
               'Fin du Si sur la ligne d'un salarié j'ai au moins un chiffre 1
               End If
                    
          'fin du Si le service est différent de 'S1'
           End If
      
    'Fin de Boucle de lecture des lignes
     Next Tourne
   'Fin de Ne pas traiter l'onglet BD
    End If
'fin de Boucle de balayage jour
 Next Onglet
End Sub

 

[ivan27]

Re-bonjour le Forum, camarchepas,
Merci beaucoup pour ta proposition.
Grâce aux commentaires très détaillés j'ai pu adapter très facilement ton code sur ma version de production.
Je te réitère mes remerciements.
Bonne fin de journée à tous
Ivan