Supprimer une ligne

Bonjour,

Je n'arrive pas à supprimer ma ligne. Message "La methode delete de la classe range a échouée"

J'ai 2 tableau et je voudrais qu'il compart chaque valeur de la colonne B de mon 1er tableau (sheet 1) par rapport à la colonne A de mon 2ème tableau (sheet 2), et supprimer toutes les lignes où la valeur n'existe pas dans le 2ème tableau

Dim i As Long
Dim Dlt1 As Integer

Dim Dlt2 As Integer

Dlt1 = Sheets(1).Range("B1048576").End(xlUp).Row

Dlt2 = Sheets(2).Range("A1048576").End(xlUp).Row

For i = Dlt1 To 1 Step -1
If Sheets(2).Range("A2:A" & Dlt2).Find(Sheets(1).Range("B" & i )) Is Nothing Then
Sheets(1).Rows(i).EntireRow.Delete
End If
Next i

Merci

Bonjour,

Essayez ceci

    Dim i As Long
    Dim Dlt1 As Integer
    Dim Dlt2 As Integer
    Dim f1 As Worksheet, f2 As Worksheet

    Application.ScreenUpdating = False
    Set f1 = Sheets(Sheets(1).Name)
    Set f2 = Sheets(Sheets(2).Name)
    Dlt1 = f1.Range("B" & Rows.Count).End(xlUp).Row
    Dlt2 = f2.Range("A" & Rows.Count).End(xlUp).Row
    For i = Dlt1 To 1 Step -1
        Valeur = f1.Range("B" & i).Value
        With f2.Range("A2:A" & Dlt2)
            Set x = .Find(Valeur)
            If x Is Nothing Then f1.Rows(i).EntireRow.Delete
        End With
    Next i
    Set f1 = Nothing
    Set f2 = Nothing

Cdlt

Bonjour,

Merci beaucoup pour ton aide.

J'ai encore le même message d'erreur :-(

Bonjour Alberti, Arturo83

@Alberti, pour éviter que l'on dialogue dans le vide, merci de joindre votre fichier SVP

A+

Bonjour,

Juste pour comprendre, pourquoi faut- il envoyer plus d'information que ce que j'ai déjà envoyé ? Est-ce que mon message d'erreur peut ne pas être dû à ma ligne qui demande de supprimer la ligne de mon tableau ?

En tout cas voilà ma macro sans les changements qui avaient été apportés par Arturo83 (juste pour donner la version initiale, même si sa macro est bien mieux que la mienne). J'essaye d'automatiser la mise à jour d'un fichier via un autre fichier, donc quand la personne clique sur le bouton, ça copie/colle les infos d'un fichier sur mon tableau puis va supprimer les informations inutiles sur un autre tableau. Tout semble bien aller jusqu'à la suppression de la ligne.

SVP : 1 - je suis totalement novice mais ai vraiment envie de réussir ma macro pour faciliter la vie au travail et éviter les erreurs dûes à trop de manipulations possibles de plein de monde, alors je me doute que c'est pas extra, mais j'apprends et je vais m'améliorer avec le temps (et je trippe les macros sur excel !! :-) )

2 - pour que je m'améliore j'ai besoin de comprendre mon erreur, alors n'hésitez pas à m'expliquer le pourquoi des changements

Private Sub ButtonGestion_Click()
Application.ScreenUpdating = False
'Démasquer les feuilles utilisées
Sheets("Filtres").Visible = True
Sheets("Formations").Visible = True
Sheets(1).Visible = True
Dim DltF, DltD As Long
MsgBox ("Importez le rapport 'Liste des employés' en format xls, nommez-le 'Liste des employés' et cliquez sur le bouton ok ci-dessous ")
'Efface les ancienne données du tableau puis copie/Colle le fichier X vers mon tableau
Windows("Formulaire formation.xlsm").Activate
Sheets("2").Select
DltF = Range("A1048576").End(xlUp).Row
Range(Cells(9, 1), Cells(DltF, 8)).Select
Selection.Clear
Windows("Liste des employés.xlsx").Activate
DltD = Range("A1048576").End(xlUp).Row
Range(Cells(2, 1), Cells(DltD, 8)).Select
Selection.Copy
Windows("Formulaire formation.xlsm").Activate
Sheets("2").Range("A9").Select
ActiveSheet.Paste
' Supprimer les formations des personnes qui ont quitté
Dim i As Long
Dim Dlt1 As Integer
Dim Dlt2 As Integer
Dlt1 = Sheets(1).Range("B1048576").End(xlUp).Row
Dlt2 = Sheets(2).Range("A1048576").End(xlUp).Row
For i = Dlt1 To 1 Step -1
If Sheets(2).Range("A2:A" & Dlt2).Find(Sheets(1).Range("B" & i )) Is Nothing Then
Sheets(1).Rows(i).EntireRow.Delete
End If
Next i
Sheets("2").Visible = False
Sheets("1").Visible = False
Application.ScreenUpdating = True
Unload FGestion
End Sub

Re,

Pour commencer, merci de mettre le code entre balise grâce au bouton </>

Ensuite, quand on code, la définition des variables se fait en début de module et non pas en plein milieu,
on indique également dans le code les objets conteneurs

Or quand on regarde cette partie du code, on ne sait pas dans quel classeur on se trouve !?

Dlt1 = Sheets(1).Range("B1048576").End(xlUp).Row
Dlt2 = Sheets(2).Range("A1048576").End(xlUp).Row
For i = Dlt1 To 1 Step -1
If Sheets(2).Range("A2:A" & Dlt2).Find(Sheets(1).Range("B" & i )) Is Nothing Then
Sheets(1).Rows(i).EntireRow.Delete
End If
Next i

Peut-être la source de l'erreur

Sinon, voici une première approche du code optimisé (avec des questions)

Private Sub ButtonGestion_Click()
  Dim WbkFF As Workbook, WbkLE As Workbook
  Dim DltF, DltD As Long
  Dim i As Long
  Dim Dlt1 As Long, Dlt2 As Long
  ' Définir les différents classeurs de travail
  Set WbkFF = Workbooks("Formulaire formation.xlsm")
  Set WbkLE = Workbooks("Liste des employés.xlsx")

  Application.ScreenUpdating = False
  'Démasquer les feuilles utilisées => dans quels classeurs !?
  Sheets("Filtres").Visible = True
  Sheets("Formations").Visible = True
  Sheets(1).Visible = True
  '
  MsgBox ("Importez le rapport 'Liste des employés' en format xls, nommez-le 'Liste des employés' et cliquez sur le bouton ok ci-dessous ")
  'Efface les ancienne données du tableau puis copie/Colle le fichier X vers mon tableau
  With WbkFF.Sheets("2")
      DltF = .Range("A" & Rows.Count).End(xlUp).Row
      .Range(.Cells(9, 1), .Cells(DltF, 8)).Clear
  End With
  With WbkLE.Sheets(1)
      DltD = .Range("A" & Rows.Count).End(xlUp).Row
      .Range(.Cells(2, 1), .Cells(DltD, 8)).Copy Destination:= _
        Workbooks("Formulaire formation.xlsm").Sheets("2").Range("A9")
  End With
  ' Supprimer les formations des personnes qui ont quitté => Dans quels classeurs
  Dlt1 = Sheets(1).Range("B" & Rows.Count).End(xlUp).Row
  Dlt2 = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row
  For i = Dlt1 To 1 Step -1
    If Sheets(2).Range("A2:A" & Dlt2).Find(Sheets(1).Range("B" & i)) Is Nothing Then
      Sheets(1).Rows(i).EntireRow.Delete
    End If
  Next i
  Sheets("2").Visible = False
  Sheets("1").Visible = False
  Application.ScreenUpdating = True
  Unload FGestion
End Sub

A+

Merci beaucoup. J'ai fait les améliorations.

En fait tout se passe dans le classeur Formulaire Formation. L'autre classeur n'est appelé que pour le copier/coller.

J'ai ajouté le classeur avant la partie du code que tu m'as montré, mais je ne suis pas sûre que ça marche comme j'ai fait vu qu'il y a la feuille 2 impliquée. En tout cas j'ai toujours le même message d'erreur.

With WbkFF.Sheets(1)

Dlt1 = .Range("B" & Rows.Count).End(xlUp).Row
Dlt2 = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row

For i = Dlt1 To 1 Step -1 
   If Sheets(2).Range("A2:A" & Dlt2).Find(.Range("B" & i)) Is Nothing Then
   .Rows(i).EntireRow.Delete
   End If
Next i
End with

En fait je viens de voir qu'il y a le message d'erreur mais que les lignes sont tout de même effacées...

Ça pourrait être dû à quoi ?

Merci

EA

Re,

Après un petit dodo est-ce que le problème ne viendrait pas tout simplement de ta boucle qui fini sur la 1ère ligne

Il faudra essayer

For i = Dlt1 To 2 Step -1 

Bon dimanche

A+

Waow c'est magique... ça marche !!!!!!!!

Merci beaucoup