Erreur 1004 - Erreur définie par l'application ou par l'objet

Résolu/Fermé
Forp74 Messages postés 6 Date d'inscription mercredi 14 octobre 2015 Statut Membre Dernière intervention 28 octobre 2017 - 28 oct. 2017 à 12:31
Forp74 Messages postés 6 Date d'inscription mercredi 14 octobre 2015 Statut Membre Dernière intervention 28 octobre 2017 - 28 oct. 2017 à 22:04
Bonjour,

Ma Config : W10 - Excel 2016.

Je ne suis pas un spécialiste de VBA Excel, mais je "bricole" un petit peu. Depuis plusieurs jours je bloque sur cette fichue erreur 1004 avec une instruction Range(). J'ai cherché sur les forum, testé pas mal de modifications, mais rien n'y fait, j'ai toujours cette fichue erreur.

Si qqun a une solution, ça m'aiderais.

Ce que fait mon programme. Je fais chercher sur un fichier des lignes de 4 champs, que je recopie triés sur une feuille. Le second champ peut être commun à plusieurs lignes
Je ne dois conserver que les 3 première lignes ayant le même second champ. Le 4e, le 5e... sont supprimées.
Si on ne rencontre que deux lignes ou une seule ligne avec ce second champ, on supprime.

Voici la partie du code où ça plante. L'erreur survient à la ligne 25. Et n'ayant pas pu tester plus loin, je suppose que ça planterait aussi sur les 2 autres lignes 39 et 47.

Ce que j'ai fait comme modifications :
1 J'ai ajouté la 1ère ligne Worksheets(NoFeuille).Select ça n'a rien changé. Sachant que NoFeuille est une variable entière définie avant.
2 Sur la ligne 25, j'ai ajouté Worksheets(NoFeuille). avant Range(...) 9a n'a rien changé.

Je tourne en rond. Merci pour le coup de main.

Worksheets(NoFeuille).Select
Range("G1").Select

Dim n As Integer
n = 0
ActiveCell.Offset(1, 0).Select
n = n + 1
Do While ActiveCell.Offset(0, 0).Value <> ""
    ' Les 3 scores sont du même club
    If ActiveCell.Offset(0, 1).Value = ActiveCell.Offset(1, 1).Value And ActiveCell.Offset(0, 1).Value = ActiveCell.Offset(2, 1).Value Then
        ' On calcule le total des 3 scores et on le place dans la 1ère ligne du club
        ActiveCell.Offset(0, 4).Select
        ActiveCell.FormulaR1C1 = "=RC[-1]+R[1]C[-1]+R[2]C[-1]"
        'ActiveCell.Offset(0, 4).Select
        
        ActiveCell.Offset(3, -4).Select
        n = n + 3
        
        ' On recherche les éventuels 4e, 5e... scores pour ne pas les sélectionner
        For n = 0 To 50
            ActiveCell.Offset(n, 0).Select
            If ActiveCell.Offset(0, 1).Value = ActiveCell.Offset(-1, 1).Value Then
                ' Suppression des celulles
                Worksheets(NoFeuille).Range(Cells(n, 7), Cells(n, 10)).Select
                Application.CutCopyMode = False
                Selection.Delete Shift:=xlUp
            Else
                GoTo Suivant
            End If
        Next
Suivant:
    Else
    ' Les lignes suivantes ne sont pas les 3 du même club
        ActiveCell.Offset(n, 0).Select
        ' Cas uniquement 2 lignes
        If ActiveCell.Offset(0, 1).Value = ActiveCell.Offset(1, 1).Value And ActiveCell.Offset(0, 1).Value <> ActiveCell.Offset(2, 1).Value Then
            Range(Cells(n, 7), Cells(n + 1, 10)).Select
            Application.CutCopyMode = False
            Selection.Delete Shift:=xlUp
        Else
        End If
        ' Cas uniquement 1 ligne
        If ActiveCell.Offset(0, 1).Value <> ActiveCell.Offset(1, 1).Value And ActiveCell.Offset(0, 1).Value <> ActiveCell.Offset(-1, 1).Value Then
           Range(Cells(n, 7), Cells(n, 10)).Select
            Application.CutCopyMode = False
            Selection.Delete Shift:=xlUp
        Else
        End If
        
    End If
ActiveCell.Offset(n, 0).Select
Loop
A voir également:

3 réponses

Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 775
28 oct. 2017 à 13:28
Bonjour,

Il faut revoir tout ton code et commencer par supprimer tous les .Select et les Activecell de ton code, ils sont inutiles et c'est la première source d'ennuis.

Au lieu de la sélectionner, il suffit de définir la cellule de référence, par exemple :
Dim cel As Range

  Set cel = Worksheets(NoFeuille).Range("G2")
  Do While cel.Value <> ""
    ' Les 3 scores sont du même club
    If cel.Offset(0, 1).Value = cel.Offset(1, 1).Value And cel.Offset(0, 1).Value = cel.Offset(2, 1).Value Then
       ' ....


2