XL 2013 Worksheet_change copier/coller sur un autre classeur

khouryndiaye

XLDnaute Nouveau
Bonjour ,

je voulais que quand la colonne E ou F change a partir de la ligne 15 ce code s’exécute.
ça ne marche pas , je vous mets les fichiers que j'ai utilisé.


VB:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim CS As Workbook
  Dim WS As Worksheet
  Dim CD As Workbook
  Dim OD As Worksheet
  Dim LI As Integer
  Dim PV As Integer
  Dim R As Range
  Dim TD As ListObject
 
  If Not Intersect(Target, Range("E15:F100")) Is Nothing Then Exit Sub
  Application.ScreenUpdating = False
  CA = "T:\UAP EMO:\Qualite\13-Audits Internes\2022\"
  Set CS = ThisWorkbook
  Set WS = CS.Worksheets("audit")
 
 
  If Target.Count > 2 Then Exit Sub
  If Target.Row < 15 Then Exit Sub
  If Target.Column < 5 Or Target.Column > 6 Then Exit Sub
Application.EnableEvents = False

If Target.Value <> 0 Then
On Error Resume Next
            Set CD = Workbooks("PDCA -Audits Coordinateurs Qualité V2022")
            If Err <> 0 Then
                Err.Clear
                Set CD = Application.Workbooks.Open(CA & "PDCA -Audits Coordinateurs Qualité V2022")
            End If
            On Error GoTo 0
            Set OD = CD.Worksheets("PDCA")
            Set TD = OD.ListObjects("PDCA")
            Set R = TD.ListColumns(1).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

  TD.DataBodyRange(PV, 1).Value = ActiveSheet.Range("A" & Target.Row).Value
  TD.DataBodyRange(PV, 13).Value = Cells(Target.Row, 4).Value 'Delai
  TD.DataBodyRange(PV, 12).Value = Cells(Target.Row, 3).Value 'Pilote
  TD.DataBodyRange(PV, 10).Value = Cells(Target.Row, 5).Value 'Action
  TD.DataBodyRange(PV, 6).Value = Cells(13, 2).Value  'installation
  TD.DataBodyRange(PV, 7).Value = Cells(14, 2).Value  ' Référence
  TD.DataBodyRange(PV, 1).Value = Cells(5, 2).Value 'Date en semaine si possible
 Application.EnableEvents = True
 End If
End If
 
End Sub
 

Pièces jointes

  • PDCA -Audits Coordinateurs Qualité V2022.xlsm
    76.4 KB · Affichages: 6
  • AUDIT de poste VIERGE.xlsm
    111.6 KB · Affichages: 5

Dafaka7

XLDnaute Junior
Bonjour @job75 ,
Je travail avec elle donc je vais mieux l'expliquer,
Toutes les cases entourés en rouge et colorier sont à reporter sur l'autre tableau, cette action doit se produire quand on rempli la colonne E à partir de la ligne 15 (la colonne est fusionné jsp si cela pose problème)
1657522616230.png


Les cellules seront collé à la dernière ligne du tableau de la feuille PDCA,
La cellule B5 sera collé sur la colonne A (l'idéal serait que cette date soit transformé en n° de semaine)
La cellule B13 = colonne F
B14 = colonne G
Ensuite selon la ligne sur laquel on écrit :
le pilote (colonne C) sera reporté sur la colonne L
Le delai (colonne D) = colonne M
l'action (colonne E et F car fusionné) = colonne J
 

Koko74

XLDnaute Nouveau
Bonjour à tous,

Sans aller trop dans le détails car cela me paraît bien complexe.

Si je comprends bien déjà l'évènement de votre code ne se déclenche pas au bon moment. En effet sur la feuille Audit l'évènement de votre code se déclenche :

VB:
  If Not Intersect(Target, Range("N6:N1000")) Is Nothing Then

Ce qui signifie qu'il s'exécute lorsque vous changer une valeur de la cellule N6 à N 1000. A ce que je comprends vous souhaitez qu'il s’exécute au changement de valeur de la cellule E15 jusqu'à E dernière ligne ?

Vu que vous avez ensuite celle ligne dans votre code :
Code:
If Target.Column < 5 Or Target.Column > 5 Then Exit Sub

Forcément le numéro de colonne ne sera jamais 5 puisque si le code se déclenche en colonne N alors le n° de colonne sera 14, donc le code quitte la procédure.

De plus si le code doit démarrer à la ligne 15 pourquoi préciser N ligne 6 et pas directement 15 ?

Je vous invite à utiliser les points d'arrêt et le pas à pas détailler (F8) pour bien comprendre comment agis votre code.

Sachant que vous travailler sur deux classeurs, vous préciser des chemins d'accès qui ne sont pas les même chez nous donc même si je modifie la colonne N par la colonne E j'ai des message d'erreur à cause des chemins : CA = "T:\UAP EMBOUT\Stage-Apprentissage\Florian DEMEY\Qualité\"

Ne serait il pas plus simple de travailler sur un seul fichier pour éviter des pb lors de déplacement de ceux ci dans vos répertoire ?

Bonne journée
 

Statistiques des forums

Discussions
311 729
Messages
2 081 971
Membres
101 852
dernier inscrit
dthi16088