supprimer ligne

[romuald]

J'ai une feuille avec 8 colonnes.
La colonne 4 represente les codes articles.
Il se peut dans la feuille (des lignes 0 à 4000) qu'il y est doublons de code article.

Je voudrai donc supprimer les lignes doublons.
Attention, il n'y a doublons que de la cellule 4, il se peut que pour un meme code article il y est des informations differentes dans les autres colonnes.
Merci

 

[pierrejean]

bonjour romuald

et s'il y a des informations differentes on supprime quand même la ligne ??

 

[romuald]

oui bien sur on supprime quand meme les lignes.
merci de ton aide

 

[pierrejean]

bonjour romuald

voila un code qui recopie les lignes correspondantes aux articles sans doublons de la colonne D de la feuil1 a la feuil2

Sub test()
Dim ligne As Integer
Dim tablo()
ReDim tablo(1)
Dim col As Collection
Set col = New Collection
On Error Resume Next
For n = 1 To Range('D65536').End(xlUp).Row
col.Add Sheets('Feuil1').Range('D' & n), CStr(Range('D' & n))
Next n
On Error GoTo 0
For n = 1 To col.Count
  For x = 1 To Sheets('Feuil1').Range('D65536').End(xlUp).Row
   If col(n) = Sheets('Feuil1').Range('D' & x) Then
      tablo(UBound(tablo)) = x
      ReDim Preserve tablo(UBound(tablo) + 1)
      Exit For
   End If
  Next x
Next n
ligne = 1
For n = 1 To UBound(tablo) - 1
Sheets('Feuil1').Range('A' & tablo(n) & ':H' & tablo(n)).Copy Destination:=Sheets('Feuil2').Range('A' & ligne) ' & ':H' & ligne)
ligne = ligne + 1
Next n
End Sub

la suppression des lignes est en fait plus complexe mais si indispensable on peut regarder

 

[romuald]

on peut modifier la macro car en fait j'ai deja une feuille 2.

Dans la feuille 1, la recherche des doublons doit ce faire de la ligne 1 à 4000.

On peut donc copier les lignes a partir de la ligne 5000 non??.

Merci d'avance.

 

[pierrejean]

re romuald

voila la modif pour lignes de 1 a 4000 et resultat en feuille3

si tu dois recopier les lignes suivantes cela ira aussi bien 'a la main' mais pas de probleme pour t'ecrire le code

Sub test()
Dim ligne As Integer
Dim tablo()
ReDim tablo(1)
Dim col As Collection
Set col = New Collection
On Error Resume Next
For n = 1 To 4000
col.Add Sheets('Feuil1').Range('D' & n), CStr(Range('D' & n))
Next n
On Error GoTo 0
For n = 1 To col.Count
  For x = 1 To 4000
   If col(n) = Sheets('Feuil1').Range('D' & x) Then
      tablo(UBound(tablo)) = x
      ReDim Preserve tablo(UBound(tablo) + 1)
      Exit For
   End If
  Next x
Next n
ligne = 1
For n = 1 To UBound(tablo) - 1
Sheets('Feuil1').Range('A' & tablo(n) & ':H' & tablo(n)).Copy Destination:=Sheets('Feuil3').Range('A' & ligne) ' & ':H' & ligne)
ligne = ligne + 1
Next n
End Sub

Message édité par: pierrejean, à: 27/06/2006 11:12

 

[pierrejean]

re romuald

voila la derniere ligne
non testée !!

Sheets('Feuil1').Range('A4000:H' & Sheets('Feuil1').Range('A65536').End(xlUp).Row).Copy Destination:=Sheets('Feuil3').Range('A' & ligne + 1)

 

[romuald]

a quoi sert cette ligne??

 

[pierrejean]

re romuald

a copier la fin de la feuil1
a partir de la ligne 4000 jusqu'a la fin