Discussion :

[Atos79]

Bonjour à tous

Voilà je reprend un développement, établi sur ce forum, qui me convient parfaitement à ceci près :
La 2e macro supprime les éléments rapprochés, pour ma part, je souhaiterai conserver les éléments dans une autre feuille Ex "éléments rapprochés" incrémenté à chaque traitement.
Ci-joint le fichier ainsi que la macro si quelqu'un pouvait me rajouter une fonction transfert... ce serait superbe.
Merci de votre réponse et de vos explications dans la macro.

[jfontaine]

Bonjour,

Ci dessous une procédure de Transfer et suppression des lignes transférées

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub Transfert()
 
Dim ShSource As Worksheet
Dim ShCible As Worksheet
Dim i As Long
 
Set ShSource = ThisWorkbook.Worksheets("DONNE")
Set ShCible = ThisWorkbook.Worksheets("Element Rapporchés")
 
'Recherche les lignes rapprochées
For i = ShSource.Range("A" & Rows.Count).Row To 3 Step -1
    'si trouvée, alors on copie la ligne
    If ShSource.Range("H" & i).Value <> "" Then
        'Copie
        ShSource.Range("A" & i & ":G" & i).Copy ShCible.Range("A" & ShCible.Range("A" & Rows.Count).End(xlUp).Row + 1)
        'Suppression
        ShSource.Rows(i).Delete
    End If
Next i
 
End Sub

[Atos79]

Merci de ta réponse le résultat est ok à ce ci que l'ai eu des lignes d'une hauteur non habituelles, mais je peux me débrouiller. Sinon tout est ok
Merci encore, j'hésiterais moins à venir lors de mes galère...
Cordialement