Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2016 Transfert des plages à un tableau conditionné

YANNISE

XLDnaute Junior
Bonjour le forum,

Je fais recours à votre aide une fois encore pour le transfert des plages sur la feuille 1 à un tableau (sous mise en forme conditionnelle) a la feuille 4

Les plages ne seront pas toutes forcement remplis lors de transfert à la feuille 4, alors je souhaite ne transférer que les plages remplis.

Mais si une plage est remplis partialement, alors un MsgBox s’affiche avec l’indication d'un manque des certains champs sur la plage x

Ci-après un tableau où il y a les numéros cellules pour chaque plage, ainsi que celles du tableau a la feuille 4

Tableau "BD_TODO" (Feuil4)ACEFGDH
En-tête Tableau (Feuil4)DateSQDCDescriptionAction(s)Pilote assignéSociétéDate objectif
Plage S (Feuil1)C26B30C32G32D37H37J37
Plage Q (Feuil1)C26B39C41G41D46H46J46
Plage D (Feuil1)C26B48C50G50D55H55J55
Plage C (Feuil1)C26B57C59G59D64H64J64

Je vous remercie d’avance pour votre aide, mon fichier ci-joint.
 

Pièces jointes

  • Exemple_report_bd.xlsm
    59.2 KB · Affichages: 4
Solution
VB:
Sub transfert()
MessageErreur = ""
Dim PlageS As Range
Dim PlageQ As Range
Dim PlageD As Range
Dim PlageC As Range

With Sheets("Feuil1") 'on définit les plages S Q D et C
    Jour = .Range("C26")
    Set PlageS = .Range("B30:J37")
    Set PlageQ = .Range("B39:J46")
    Set PlageD = .Range("B48:J55")
    Set PlageC = .Range("B57:J64")
End With

'on check si les plages sont remplies avec toutes les infos
chkS = CheckPlage(PlageS, "S")
chkQ = CheckPlage(PlageQ, "Q")
chkD = CheckPlage(PlageD, "D")
chkC = CheckPlage(PlageC, "C")

'si il manque une info quelque part, un message apparait
If Not chkS Or Not chkQ Or Not chkD Or Not chkC Then
    If MsgBox(MessageErreur & Chr(10) & Chr(10) & Chr(10) & "Souhaitez vous continuer?", vbYesNo) =...

YANNISE

XLDnaute Junior
Merci @vgendron,

mais il me manque une condition :

si par exemple la plage S est remplie et les autres non alors le transfert s'exécute
mais sur la plage S si il manque un champ non rempli alors un message d'alerte s'affiche (juste pour le champ manquant sur la plage S)



Merci bcp
 

vgendron

XLDnaute Barbatruc
si par exemple la plage S est remplie et les autres non alors le transfert s'exécute
Exact, c'est ce que fait la macro

mais sur la plage S si il manque un champ non rempli alors un message d'alerte s'affiche (juste pour le champ manquant sur la plage S)
Exact, c'est ce que fait la macro

on peut résumer par: SI il manque UNE info dans une plage, il y a message
SI tu réponds OUI au msgbox, l'enregistrement des plages s'effecue
Si tu réponds NON: rien ne se passe..


et donc, c'est quoi la question??
pour rappel: ta demande
Mais si une plage est remplis partialement, alors un MsgBox s’affiche avec l’indication d'un manque des certains champs sur la plage x
 

vgendron

XLDnaute Barbatruc
en réfléchissant un peu.. il suffit d'ajouter un test avant de copier

VB:
Sub transfert()
MessageErreur = ""
Dim PlageS As Range
Dim PlageQ As Range
Dim PlageD As Range
Dim PlageC As Range


With Sheets("Feuil1") 'on définit les plages S Q D et C
    Jour = .Range("C26")
    Set PlageS = .Range("B30:J37")
    Set PlageQ = .Range("B39:J46")
    Set PlageD = .Range("B48:J55")
    Set PlageC = .Range("B57:J64")
End With


'on check si les plages sont remplies avec toutes les infos
chkS = CheckPlage(PlageS, "S")
chkQ = CheckPlage(PlageQ, "Q")
chkd = CheckPlage(PlageD, "D")
chkC = CheckPlage(PlageC, "C")


'si il manque une info quelque part, un message apparait
If Not chkS Or Not chkQ Or Not chkd Or Not chkC Then
    If MsgBox(MessageErreur & Chr(10) & Chr(10) & Chr(10) & "Souhaitez vous continuer?", vbYesNo) = vbNo Then Exit Sub
End If


'remplissage de la table BD_TODO
With Sheets("Feuil4").ListObjects("BD_TODO")
    'PlageS
    If chkS Then
        .ListRows.Add 'on ajoute une ligne
        LastLine = .ListRows.Count 'dernière ligne
        'on colle les infos
        .DataBodyRange(LastLine, 1) = Jour 'Jour
        .DataBodyRange(LastLine, 2) = PlageS.Cells(1, 2) 'Statut
        .DataBodyRange(LastLine, 3) = "S" 'Acronyme
        .DataBodyRange(LastLine, 4) = PlageS.Cells(8, 7) 'Société
        .DataBodyRange(LastLine, 5) = PlageS.Cells(3, 2) 'Description pb
        .DataBodyRange(LastLine, 6) = PlageS.Cells(3, 6) 'Action
        .DataBodyRange(LastLine, 7) = PlageS.Cells(8, 3) 'Pilote
        .DataBodyRange(LastLine, 8) = PlageS.Cells(8, 9) 'Date objectif
        .DataBodyRange(LastLine, 9) = "?" 'Date Cloture
        .DataBodyRange(LastLine, 10) = "?" 'Escalader
        .DataBodyRange(LastLine, 11) = "?" 'Info
    End If
    
    'idem pour la plage suivante
    If checkQ Then
        'PlageQ
        .ListRows.Add
        LastLine = .ListRows.Count
        .DataBodyRange(LastLine, 1) = Jour 'Jour
        .DataBodyRange(LastLine, 2) = PlageQ.Cells(1, 2) 'Statut
        .DataBodyRange(LastLine, 3) = "Q" 'Acronyme
        .DataBodyRange(LastLine, 4) = PlageQ.Cells(8, 7) 'Société
        .DataBodyRange(LastLine, 5) = PlageQ.Cells(3, 2) 'Description pb
        .DataBodyRange(LastLine, 6) = PlageQ.Cells(3, 6) 'Action
        .DataBodyRange(LastLine, 7) = PlageQ.Cells(8, 3) 'Pilote
        .DataBodyRange(LastLine, 8) = PlageQ.Cells(8, 9) 'Date objectif
        .DataBodyRange(LastLine, 9) = "?" 'Date Cloture
        .DataBodyRange(LastLine, 10) = "?" 'Escalader
        .DataBodyRange(LastLine, 11) = "?" 'Info
    End If
    
    If chekcD Then
        'PlageD
        .ListRows.Add
        LastLine = .ListRows.Count
        .DataBodyRange(LastLine, 1) = Jour 'Jour
        .DataBodyRange(LastLine, 2) = PlageD.Cells(1, 2) 'Statut
        .DataBodyRange(LastLine, 3) = "D" 'Acronyme
        .DataBodyRange(LastLine, 4) = PlageD.Cells(8, 7) 'Société
        .DataBodyRange(LastLine, 5) = PlageD.Cells(3, 2) 'Description pb
        .DataBodyRange(LastLine, 6) = PlageD.Cells(3, 6) 'Action
        .DataBodyRange(LastLine, 7) = PlageD.Cells(8, 3) 'Pilote
        .DataBodyRange(LastLine, 8) = PlageD.Cells(8, 9) 'Date objectif
        .DataBodyRange(LastLine, 9) = "?" 'Date Cloture
        .DataBodyRange(LastLine, 10) = "?" 'Escalader
        .DataBodyRange(LastLine, 11) = "?" 'Info
    End If
    
    If checkC Then
        'PlageC
        .ListRows.Add
        LastLine = .ListRows.Count
        .DataBodyRange(LastLine, 1) = Jour 'Jour
        .DataBodyRange(LastLine, 2) = PlageC.Cells(1, 2) 'Statut
        .DataBodyRange(LastLine, 3) = "C" 'Acronyme
        .DataBodyRange(LastLine, 4) = PlageC.Cells(8, 7) 'Société
        .DataBodyRange(LastLine, 5) = PlageC.Cells(3, 2) 'Description pb
        .DataBodyRange(LastLine, 6) = PlageC.Cells(3, 6) 'Action
        .DataBodyRange(LastLine, 7) = PlageC.Cells(8, 3) 'Pilote
        .DataBodyRange(LastLine, 8) = PlageC.Cells(8, 9) 'Date objectif
        .DataBodyRange(LastLine, 9) = "?" 'Date Cloture
        .DataBodyRange(LastLine, 10) = "?" 'Escalader
        .DataBodyRange(LastLine, 11) = "?" 'Info
    End If
End With


End Sub
 

vgendron

XLDnaute Barbatruc
VB:
Sub transfert()
MessageErreur = ""
Dim PlageS As Range
Dim PlageQ As Range
Dim PlageD As Range
Dim PlageC As Range

With Sheets("Feuil1") 'on définit les plages S Q D et C
    Jour = .Range("C26")
    Set PlageS = .Range("B30:J37")
    Set PlageQ = .Range("B39:J46")
    Set PlageD = .Range("B48:J55")
    Set PlageC = .Range("B57:J64")
End With

'on check si les plages sont remplies avec toutes les infos
chkS = CheckPlage(PlageS, "S")
chkQ = CheckPlage(PlageQ, "Q")
chkD = CheckPlage(PlageD, "D")
chkC = CheckPlage(PlageC, "C")

'si il manque une info quelque part, un message apparait
If Not chkS Or Not chkQ Or Not chkD Or Not chkC Then
    If MsgBox(MessageErreur & Chr(10) & Chr(10) & Chr(10) & "Souhaitez vous continuer?", vbYesNo) = vbNo Then Exit Sub
End If

'remplissage de la table BD_TODO
With Sheets("Feuil4").ListObjects("BD_TODO")
    'PlageS
    If chkS Then
        .ListRows.Add 'on ajoute une ligne
        LastLine = .ListRows.Count 'dernière ligne
        'on colle les infos
        .DataBodyRange(LastLine, 1) = Jour 'Jour
        .DataBodyRange(LastLine, 2) = PlageS.Cells(1, 2) 'Statut
        .DataBodyRange(LastLine, 3) = "S" 'Acronyme
        .DataBodyRange(LastLine, 4) = PlageS.Cells(8, 7) 'Société
        .DataBodyRange(LastLine, 5) = PlageS.Cells(3, 2) 'Description pb
        .DataBodyRange(LastLine, 6) = PlageS.Cells(3, 6) 'Action
        .DataBodyRange(LastLine, 7) = PlageS.Cells(8, 3) 'Pilote
        .DataBodyRange(LastLine, 8) = PlageS.Cells(8, 9) 'Date objectif
        .DataBodyRange(LastLine, 9) = "?" 'Date Cloture
        .DataBodyRange(LastLine, 10) = "?" 'Escalader
        .DataBodyRange(LastLine, 11) = "?" 'Info
    End If
    
    'idem pour la plage suivante
    If chkQ Then
        'PlageQ
        .ListRows.Add
        LastLine = .ListRows.Count
        .DataBodyRange(LastLine, 1) = Jour 'Jour
        .DataBodyRange(LastLine, 2) = PlageQ.Cells(1, 2) 'Statut
        .DataBodyRange(LastLine, 3) = "Q" 'Acronyme
        .DataBodyRange(LastLine, 4) = PlageQ.Cells(8, 7) 'Société
        .DataBodyRange(LastLine, 5) = PlageQ.Cells(3, 2) 'Description pb
        .DataBodyRange(LastLine, 6) = PlageQ.Cells(3, 6) 'Action
        .DataBodyRange(LastLine, 7) = PlageQ.Cells(8, 3) 'Pilote
        .DataBodyRange(LastLine, 8) = PlageQ.Cells(8, 9) 'Date objectif
        .DataBodyRange(LastLine, 9) = "?" 'Date Cloture
        .DataBodyRange(LastLine, 10) = "?" 'Escalader
        .DataBodyRange(LastLine, 11) = "?" 'Info
    End If
    
    If chkD Then
        'PlageD
        .ListRows.Add
        LastLine = .ListRows.Count
        .DataBodyRange(LastLine, 1) = Jour 'Jour
        .DataBodyRange(LastLine, 2) = PlageD.Cells(1, 2) 'Statut
        .DataBodyRange(LastLine, 3) = "D" 'Acronyme
        .DataBodyRange(LastLine, 4) = PlageD.Cells(8, 7) 'Société
        .DataBodyRange(LastLine, 5) = PlageD.Cells(3, 2) 'Description pb
        .DataBodyRange(LastLine, 6) = PlageD.Cells(3, 6) 'Action
        .DataBodyRange(LastLine, 7) = PlageD.Cells(8, 3) 'Pilote
        .DataBodyRange(LastLine, 8) = PlageD.Cells(8, 9) 'Date objectif
        .DataBodyRange(LastLine, 9) = "?" 'Date Cloture
        .DataBodyRange(LastLine, 10) = "?" 'Escalader
        .DataBodyRange(LastLine, 11) = "?" 'Info
    End If
    
    If chkC Then
        'PlageC
        .ListRows.Add
        LastLine = .ListRows.Count
        .DataBodyRange(LastLine, 1) = Jour 'Jour
        .DataBodyRange(LastLine, 2) = PlageC.Cells(1, 2) 'Statut
        .DataBodyRange(LastLine, 3) = "C" 'Acronyme
        .DataBodyRange(LastLine, 4) = PlageC.Cells(8, 7) 'Société
        .DataBodyRange(LastLine, 5) = PlageC.Cells(3, 2) 'Description pb
        .DataBodyRange(LastLine, 6) = PlageC.Cells(3, 6) 'Action
        .DataBodyRange(LastLine, 7) = PlageC.Cells(8, 3) 'Pilote
        .DataBodyRange(LastLine, 8) = PlageC.Cells(8, 9) 'Date objectif
        .DataBodyRange(LastLine, 9) = "?" 'Date Cloture
        .DataBodyRange(LastLine, 10) = "?" 'Escalader
        .DataBodyRange(LastLine, 11) = "?" 'Info
    End If
End With

End Sub
 
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…