Mise à jour automatique de données.

[cotcot]

Bonjour à tous !

Voila après de nombreuses recherches sur internet, je n'ai rien trouvé pour résoudre mon problème !

Je souhaite en fait que lorsque je rentre des données dans ma première feuille, que les nouveaux "Code prestataires" se copient dans la feuille "Listes" dans la bonne colonne. La mise à jour de ces données se ferait d'un peut n'importe qu'elle façon (au changement de page ? ou autre).

J'ai essayé pas mal de truc, sans succès

Je vous remercie de l'attention que vous porterez à mon sujet !

 

[fanfan38]

Re : Mise à jour automatique de données.

Bonjour
En cliquant sur le nom de la 1ere feuille avec le bouton droit choisir visualiser le code
copier et coller la macro ci dessous

Private Sub Worksheet_Change(ByVal Target As Range)
Dim macol As Integer
Dim derlig As Integer
If Target.Column <> 3 Then Exit Sub
Select Case Left(Target.Value, 3)
Case Is = "AVO"
macol = 6
Case Is = "CAC"
macol = 7
Case Is = "CON"
macol = 8
Case Is = "EDI"
macol = 9
Case Is = "HUI"
macol = 10
Case Is = "INS"
macol = 11
Case Is = "NOT"
macol = 12
End Select
If macol < 6 Then Exit Sub
derlig = Sheets("Listes").Cells(65535, macol).End(xlUp).Row
For i = 1 To derlig
If Sheets("Listes").Cells(i, macol).Value = Target.Value Then
Exit Sub
End If
Next
Sheets("Listes").Cells(derlig + 1, macol).Value = Target.Value
End Sub

A+ François

 

[cotcot]

Re : Mise à jour automatique de données.

Merci pour cette réponse si rapide!!!
Je test et je vous fait un retour dès que j'aurais finis

Merci encore !

 

[job75]

Re : Mise à jour automatique de données.

Bonjour cotcot, fanfan38,

Cette macro, dans le code la feuille Listes, se lance quand on active la feuille :

Option Explicit
Option Compare Text 'ne tient pas compte de la casse

Private Sub Worksheet_Activate() 'se lance quand la feuille est activée
Dim tablo, plage As Range, cel As Range, d As Object, i&, txt$
With Sheets("Prestataires Juridique")
  tablo = .Range("C4:D" & .[C65536].End(xlUp).Row) 'matrice, plus rapide
End With
Application.ScreenUpdating = False
[F3:IV65536].Clear 'efface tout
On Error Resume Next 'si aucun texte en F1:IV1
Set plage = [F1:IV1].SpecialCells(xlCellTypeConstants, 2)
If Err Then Exit Sub
On Error GoTo 0
For Each cel In plage
  Set d = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(tablo) 'liste sans doublons, en majuscules
    txt = tablo(i, 1)
    If Left(txt, 3) = Left(cel, 3) Then d(UCase(txt)) = UCase(txt)
  Next
  If d.Count Then
    With cel.Offset(2).Resize(d.Count)
      .Value = Application.Transpose(d.Keys)
      .Sort .Cells, xlAscending, Header:=xlNo 'tri
      .Borders.LineStyle = 1 'bordures
    End With
  End If
Next
Application.ScreenUpdating = True
End Sub

Fichier joint.

Edit : fanfan38 a raison, comme il y a un accent, il faut comparer les 3 premiers caractères, j'ai modifié la macro...

A+

 

[job75]

Re : Mise à jour automatique de données.

Re,

Le contrôle d'erreur au début ne me plaît pas, prenez cette version (2) :

Option Explicit
Option Compare Text 'ne tient pas compte de la casse

Private Sub Worksheet_Activate() 'se lance quand la feuille est activée
Dim tablo, plage As Range, cel As Range, d As Object, i&, txt$
With Sheets("Prestataires Juridique")
  tablo = .Range("C4:D" & .[C65536].End(xlUp).Row) 'matrice, plus rapide
End With
Application.ScreenUpdating = False
[F3:IV65536].Clear 'efface tout
If Application.CountA([F1:IV1]) = 0 Then Exit Sub
Set plage = [F1:IV1].SpecialCells(xlCellTypeConstants)
For Each cel In plage
  Set d = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(tablo) 'liste sans doublons, en majuscules
    txt = tablo(i, 1)
    If Left(txt, 3) = Left(cel, 3) Then d(UCase(txt)) = UCase(txt)
  Next
  If d.Count Then
    With cel.Offset(2).Resize(d.Count)
      .Value = Application.Transpose(d.Keys)
      .Sort .Cells, xlAscending, Header:=xlNo 'tri
      .Borders.LineStyle = 1 'bordures
    End With
  End If
Next
Application.ScreenUpdating = True
End Sub

A+

 

[job75]

Re : Mise à jour automatique de données.

Bonjour le fil, le forum,

Si les en-têtes de colonnes sont dans des cellules fusionnées, il faut prendre des précautions :

Option Explicit
Option Compare Text 'ne tient pas compte de la casse

Private Sub Worksheet_Activate() 'se lance quand la feuille est activée
Dim tablo, plage As Range, cel As Range, txt1$, d As Object, i&, txt2$
With Sheets("Prestataires Juridique")
  tablo = .Range("C4:D" & .[C65536].End(xlUp).Row) 'matrice, plus rapide
End With
Application.ScreenUpdating = False
[F3:IV65536].Clear 'efface tout
If Application.CountA([F1:IV1]) = 0 Then Exit Sub
Set plage = [F1:IV1].SpecialCells(xlCellTypeConstants)
For Each cel In plage
  If cel <> "" Then 'pour cellule vide dans cellule fusionnée
    txt1 = Left(cel, 3)
    Set d = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(tablo) 'liste sans doublons, en majuscules
      txt2 = tablo(i, 1)
      If Left(txt2, 3) = txt1 Then d(UCase(txt2)) = UCase(txt2)
    Next
    If d.Count Then
      With Cells(3, cel.Column).Resize(d.Count, 1)
        .Value = Application.Transpose(d.Keys)
        If d.Count > 1 Then .Sort .Cells, xlAscending, Header:=xlNo 'tri
        .Borders.LineStyle = 1 'bordures
      End With
    End If
  End If
Next
Application.ScreenUpdating = True
End Sub

Version (3).

A+

 

[cotcot]

Re : Mise à jour automatique de données.

Merci encore à vous deux pour votre travail et votre attention! Pour Fanfan38, j'ai testé mais il ne se passe rien :S
Je vais tester votre solution Job75 et vous fait un retour dans les minutes qui viennent!!

 

[cotcot]

Re : Mise à jour automatique de données.

Et bien à priori, tout fonctionne correctement grâce au code de Job75 !
Je ne sais pas comment vous remercier pour votre travail !!
Merci encore pour votre rapidité et votre professionnalisme!!

Je vous tiendrais au courant via le fil si il apparaît des bugs ^^

Merci encore Job75 !! Et Fanfan38 ^^