Problème macro de copier/coller certaines colonnes selon condition

[Rhaly]

Bonjour à tous et au forum!

Voila je reviens vers vous toujours pour la même macro qui me pose quelques petits problèmes. Je vous ré-explique déjà le but de cette macro :

J'ai 10 conseillers qui ont chacun leurs feuilles de batonnage pour quantifier leur prod.
Cette macro copie les données des colonnes "Type", "Centre", "Client", "Date" et Nom dans le fichiers corrections à chaque fois que la case "A Imprimer" est remplie.
Un enregistrement est effectué avant et après l’exécution pour éviter d'écraser les données.

Mon 1er problème vient du fait que le fichier est partagé par 10 personnes; on a eu le cas aujourd'hui de 2 personnes qui ont coché en même temps soit 2 enregistrement en meme temps dont un qui n'a pas fonctionné. Du coup, seulement 1 de ces 2 lignes ont pu être copié. Y aurait il un moyen de bloquer la copie tant que le fichier n'est pas sauvegardé?

Mon 2eme souci est que je voudrai remplacer le "X" se situant dans la case à imprimer par le statut se situant dans la feuille correction sur la feuille du conseiller pour la ligne concerné.

Et enfin question bête mais est ce que cette macro inséré dans chacune des 10 feuilles risque de ralentir le fichier fortement?

Je sais pas si cela est possible!

Vous remerciant d'avance

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count > 1 Then Exit Sub

If Not Intersect(Target, Range("A_Imprimer")) Is Nothing Then

ActiveWorkbook.Save

If Target.Value <> "" Then
With Sheets("CORRECTIONS")
LigVide = .Range("A65536").End(xlUp).Row + 1
.Cells(LigVide, 1) = Target.Offset(0, -8).Value
.Cells(LigVide, 2) = Target.Offset(0, -7).Value
.Cells(LigVide, 3) = Target.Offset(0, -6).Value
.Cells(LigVide, 4) = Target.Offset(0, -5).Value
.Cells(LigVide, 5) = Target.Offset(0, 2).Value

End With

ActiveWorkbook.Save

End If
End If

End Sub

 

[Compte Supprimé 979]

Re : Problème macro de copier/coller certaines colonnes selon condition

Salut Rhaly

Pour ton 1er problème, essaye ce code

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  If Not Intersect(Target, Range("A_Imprimer")) Is Nothing Then
    On Error Resume Next
    ActiveWorkbook.Save
    If Err.Number <> 0 Then
      MsgBox "Impossible d'enregistrer le classeur pour le moment !"
      ' Effacer le contenu de "A Imprimer"
      Application.EnableEvents = False
      Target.ClearContents
      Application.EnableEvents = True
      On Error GoTo 0
      ' Sortir de la sub
      Exit Sub
    End If
    On Error GoTo 0
    If Target.Value <> "" Then
      With Sheets("CORRECTIONS")
        LigVide = .Range("A65536").End(xlUp).Row + 1
        .Cells(LigVide, 1) = Target.Offset(0, -8).Value
        .Cells(LigVide, 2) = Target.Offset(0, -7).Value
        .Cells(LigVide, 3) = Target.Offset(0, -6).Value
        .Cells(LigVide, 4) = Target.Offset(0, -5).Value
        .Cells(LigVide, 5) = Target.Offset(0, 2).Value
      End With
      ActiveWorkbook.Save
    End If
  End If
End Sub

Pour le 2ème, je ne sais pas

Pour le 3ème, je ne pense pas, mais tu peux mettre le code dans ThisWorkbook en l'adaptant

A

 

[Rhaly]

Re : Problème macro de copier/coller certaines colonnes selon condition

Bonjour Bruno!
Après test de ta macro ce midi cela semble bien fonctionner sauf si la case est coché à 1 seconde près par 2 conseillers car cela entraîne l'ouverture d'une fenêtre de conflit. Malgré tout je pense être sur la bonne voie grâce à ton aide. Merci!