XL 2016 Transfert des plages à un tableau conditionné

YANNISE · 7 Juin 2023

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)	A	C	E	F	G	D	H
En-tête Tableau (Feuil4)	Date	SQDC	Description	Action(s)	Pilote assigné	Société	Date objectif
Plage S (Feuil1)	C26	B30	C32	G32	D37	H37	J37
Plage Q (Feuil1)	C26	B39	C41	G41	D46	H46	J46
Plage D (Feuil1)	C26	B48	C50	G50	D55	H55	J55
Plage C (Feuil1)	C26	B57	C59	G59	D64	H64	J64

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

vgendron · 7 Juin 2023

Bonjour

Perso.. je n'ai strictement rien compris à la demande....
Quelles données vont où ?

YANNISE · 7 Juin 2023

@vgendron bonjour,

les données sur la feuille 1 vers tableau sur la feuille 4

merci.

vgendron · 7 Juin 2023

voir PJ
avec du code à adapter.. j'y ai mis des commentaires

YANNISE · 7 Juin 2023

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 · 7 Juin 2023

YANNISE à dit:
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

YANNISE à dit:
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

YANNISE · 7 Juin 2023

Mais quand j'ai fait le transfert seulement de la plage S voila se qu'il donne

Normalement les plages Q;D;C ne devraient pas être collés sur le tableau car ils sont vides

vgendron · 7 Juin 2023

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

YANNISE · 7 Juin 2023

ouiii parfait merci beaucoup, mais pour le MsgBox il peux avoir seulement que le contrôle des plages qu'ont remplis
dans si par exemple pour la plage S tous est remplis pas de MsgBox

vgendron · 7 Juin 2023

YANNISE à dit:
mais pour le MsgBox il peux avoir seulement que le contrôle des plages qu'ont remplis
dans si par exemple pour la plage S tous est remplis pas de MsgBox

??? en Français. ca donne quoi??

YANNISE · 7 Juin 2023

si je remplis la plage S le contrôle des champs vides s'applique que sur la plage S

un autre souci, le transfert ne ce fait pas si deux plages sont remplies

vgendron · 7 Juin 2023

Réfléchi et regarde le code et les commentaires avant de poster !

YANNISE · 7 Juin 2023

Désolé @vgendron mais je n'ai pas compris, je vois pas ou je dois modifier

vgendron · 7 Juin 2023

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

YANNISE · 7 Juin 2023

@vgendron Merci bcp ^^

Effectuez une recherche sur Excel Downloads...

XL 2016 Transfert des plages à un tableau conditionné

YANNISE

XLDnaute Junior

Pièces jointes

vgendron

vgendron

XLDnaute Barbatruc

YANNISE

XLDnaute Junior

vgendron

XLDnaute Barbatruc

Pièces jointes

YANNISE

XLDnaute Junior

vgendron

XLDnaute Barbatruc

YANNISE

XLDnaute Junior

vgendron

XLDnaute Barbatruc

YANNISE

XLDnaute Junior

vgendron

XLDnaute Barbatruc

YANNISE

XLDnaute Junior

vgendron

XLDnaute Barbatruc

YANNISE

XLDnaute Junior

vgendron

XLDnaute Barbatruc

YANNISE

XLDnaute Junior

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums