Mise à jour des lignes d'une feuille d'une macro
Bonjour et bonne année,
J'ai un petit soucis de macro avec un de mes classeurs et j'aurai besoin de votre expérience.
J'ai une première feuilles (Feuil1) qui possède des centaines de lignes dans l'original
J'ai une seconde feuille ou j'avais réalisé une macro qui me récupère toutes les lignes qui contienne un nom (dans le classeur en exemple c'est LUKAS)
Dans l'exemple du fichier Excel que j'ai créé les ligne ou LUKAS est écrit sont en 3,6,9,10 cependant dans l'original les lignes sont répartis dans tout le fichier et des nouvelles se rajouterons.
Il m'arrive de modifier les informations dans la Feuil2 (Excepté le nom LUKAS ) et je souhaite que lorsque je modifie je puisse appliquer une macro qui mettrai à jour les lignes existantes comprenant LUKAS sans bouger l'ordre des lignes existante dans la Feuil1.
Dans le code suivant je copie toutes les lignes de la Feuil2 en m'aidant de la valeur LUKAS et colle dans la Feuil1 cependant cela ne remplace pas les lignes déjà existantes de la Feuil1 et ne fais que rajouter au début les lignes.
Or je souhaite que cela remplace les lignes existantes.
J'avais l'idée de refaire une boucle FOR each et un IF value like *LUKAS* pour la feuil1 coller la ligne mais je suis bloqué.
Pourriez-vous m'aider ?
Merci
Sub MajFeuil1()
' MajFeuil1 Macro
Dim Cell As Range
With Worksheets("Feuil1")
For Each Cell In .Range("F1:F" & .Cells(.Rows.Count, "F").End(xlUp).Row)
If Cell.Value Like "*LUKAS*" Then
.Rows(Cell.Row).Copy Destination:=Sheets("Feuil2").Rows(Cell.Row)
End If
Next Cell
End With
End SubBonsoir
Le chiffre mentionné en colonne E est unique pour chaque Lukas ?
Cordialement
Bonsoir,
Merci de votre réponse.
Le chiffre est en effet unique pour un même prénom cependant il peut y avoir des doublons de chiffre avec d'autres prénoms.
J'étais justement entrain de faire une macro qui mettrai à jour en utilisant l'identifiant sans prendre en compte les doublons pour le moment
Voilà une ébauche :
Sub Maj()
Set FS = Sheets("Feuil2")
Set FD = Sheets("Feuil1")
DFS = FS .Cells(Rows.Count, 1).End(xlUp).Row ' dernière ligne de Fichier Source
DFD = FD.Cells(Rows.Count, 1).End(xlUp).Row ' dernière ligne de Fichier Destination
For i = 2 To FS 'on parcourt toutes les lignes du fichier source
Set re = wso.Range("E2:E" & DFD).Find(FS.Cells(i, 1), lookat:=xlPart) 'on cherche le numéro de dossier dans fichier de destination
End SubCordialement,
Petite mise à jour maintenant j'arrive à faire ce que je veux et mettre à jour mon fichier de destination, cependant il me manque la prise en charge de doublon car s’il y a le même nombre, 2 lignes seront modifiées. J'utilise la colonne E avec les nombres et il peut y avoir des doublons cependant il n'y a qu'un chiffre unique par date et je cherche donc à adapter cette macro pour que la vérification se fasse sur les 2 colonnes.
Comme ça si le nombre 808 est trouvé 2 fois la date permettrai de distinguer ou de rendre la ligne uniqueSet FS = Sheets("Feuil2")
Set FD = Sheets("Feuil1")
DFS = FS .Cells(Rows.Count, 1).End(xlUp).Row ' dernière ligne de Fichier Source
DFD = FD.Cells(Rows.Count, 1).End(xlUp).Row ' dernière ligne de Fichier Destination
For i = 2 To DFS 'on parcourt toutes les lignes du fichier source
Set re = FD.Range("E2:E" & DFD).Find(FS.Cells(i, 5), lookat:=xlPart)
If re Is Nothing Then
lam = DFD + 1
Else
lam = re.Row
FS.Rows(i).Copy FD.Cells(lam, 1)
Next iBonjour
Essayez avec ce code à placer dans la feuille 2. Le code fera ce que vous demandez dès que vous changez une valeur dans la feuille 2 pour le nom LUKAS
Pour le placer, cliquez droite sur le nom de l'onglet Feuil2 puis choisissez "Visualiser le code".
Ensuite coller le code ci-dessous.
Private Sub Worksheet_Change(ByVal Target As Range)
If UCase(Range("F" & Target.Row)) = "LUKAS" Then
Dim num as integer
Dim FD as worksheet
num = Range("E" & Target.Row)
Set FD = Sheets("Feuil1")
Dim c As Range
Dim prem As String
With FD.Range("E:E")
Set c = .Find(num, LookIn:=xlValues)
If Not c Is Nothing Then
prem = c.Address
Do
If UCase(FD.Range(c.Address).Offset(0, 1)) = "LUKAS" And FD.Range(c.Address) = num Then
With FD
.Range("A" & c.Row).Value = Range("A" & Target.Row).Value
.Range("B" & c.Row).Value = Range("B" & Target.Row).Value
.Range("C" & c.Row).Value = Range("C" & Target.Row).Value
.Range("D" & c.Row).Value = Range("D" & Target.Row).Value
.Range("G" & c.Row).Value = Range("G" & Target.Row).Value
.Range("H" & c.Row).Value = Range("H" & Target.Row).Value
End With
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> prem
End If
End With
End If
End SubCordialement
Heu, le fil est cloturé sans suite ?