Sub qualité()
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim CS As Workbook 'définit la variable CS (classeur Source)
Dim OS As Worksheet 'définit la variable OS (Onglet Source)
Dim TS As ListObject 'définit la variable TS (Tableau Source)
Dim LI As Integer 'définit la variable LI (Ligne)
Dim CD As Workbook 'définit la variable CD (Classeur Destination)
Dim OD As Worksheet 'définit la variable OD (Onglet Destination)
Dim TD As ListObject 'définit la variable RD (Tableau Destination)
Dim R As Range 'définit la variable R (Recherche)
Dim PV As Integer 'définit la variable PV (Première ligne Vide)
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
CA = "T:\UAP EMBOUT\PDCA\"
Set CS = ThisWorkbook 'définit le classeur source CS
Set OS = CS.Worksheets("Récupération") 'définit l'onglet source OS
Set TS = OS.ListObjects("Tab_PDCA") 'définit le tableau structuré source
LI = TS.ListRows.Count 'définit la ligne LI
'service Qualité
If TS.DataBodyRange(LI, 5).Value = "Qualité" Then 'condition 1 : si le service est "Qualité"
On Error Resume Next 'gestion des erreur (en cas dérreur passe à la ligne suivante)
Set CD = Workbooks("PDCA UAP QUALITE.xlsm") 'définit le classeur destination CQ (génère une erreur si le classeur n'est pas ouvert)
If Err <> 0 Then 'condition : si une erreur a été générée
Err.Clear 'supprime l'erreur
Set CD = Application.Workbooks.Open(CA & "PDCA UAP QUALITE.xlsm") 'définit le classeur destination CQ en l'ouvrant
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
Set OD = CD.Worksheets("Plan d'action") 'définit l'onglet destination OD
Set TD = OD.ListObjects("T_action3") 'définit le tableau structuré destinatkion TD
'ajout des valeurs dans TD
Set R = TD.ListColumns(3).Range.Find("") 'définit la recherche R (recherche du vide dans la colonne 1 de TD)
If R Is Nothing Or TD.ListRows.Count = 0 Then 'condition 2 : si aucune occurrence n'est trouvée
TD.ListRows.Add 'ajoute une ligne à TD
PV = TD.ListRows.Count 'définit la ligne PV (Première ligne Vide de la colonne 3 de TD)
Else 'sinon (au moins une occurrence est trouvée)
PV = R.Row - TD.HeaderRowRange.Row 'définit la ligne PV (ligne de la première occurrence trouvée moins la ligne des en-têtes de TD)
End If 'fin de la condition 2
End If 'fin de la condition 1
'service prodution
If TS.DataBodyRange(LI, 5).Value = "Production" Then
On Error Resume Next
Set CD = Workbooks("PDCA Production.xlsm")
If Err <> 0 Then
Err.Clear
Set CD = Application.Workbooks.Open(CA & "PDCA Production.xlsm")
End If
On Error GoTo 0
Set OD = CD.Worksheets("Plan d'action")
Set TD = OD.ListObjects("T_Prod")
Set R = TD.ListColumns(3).Range.Find("")
If R Is Nothing Or TD.ListRows.Count = 0 Then
TD.ListRows.Add
PV = TD.ListRows.Count
Else
PV = R.Row - TD.HeaderRowRange.Row
End If
End If
'renvoie les données dans l'auter fichier
TD.DataBodyRange(PV, 1).Value = TS.DataBodyRange(LI, 1).Value
TD.DataBodyRange(PV, 3).Value = TS.DataBodyRange(LI, 2).Value
TD.DataBodyRange(PV, 7).Value = TS.DataBodyRange(LI, 3).Value
TD.DataBodyRange(PV, 10).Value = TS.DataBodyRange(LI, 4).Value
End Sub
