Bug "la méthode select de la classe worksheet a échoué"

Le 31/10/2018 à 17:13

Bonjour à tous

Je suis nouveau sur ce forum et novice en VBA, je sollicite votre aide sur une erreur que je ne parviens pas à résoudre seul.

Je suis amené dans le cadre de mon travail à "bricoler" des classeurs Excel VBA, bien que n'y connaissant rien à la base...

J'ai une macro qui bug bizarrement (erreur 1004, "la méthode select de la classe worksheet a échoué").

Cette macro est dans un classeur A actif, que j'appelle "MATRICE".

Elle a pour objet :

  • d'ouvrir un classeur B, que j'appelle "BDD" (base de données);
  • de nettoyer le contenu d'une feuille de ce classeur par un clearContents;
  • de revenir dans le classeur A, de copier certaines données triées par macro,
  • puis de coller ces données triées dans le classeur B, d'enregistrer et de fermer ce classeur.

Je sais que la partie de la macro "tri et copie" n'est pas en cause, car elle fonctionnait très bien auparavant, entre 2 feuilles d'un même classeur. C'est depuis que j'essaye de faire un collage dans le classeur B que ça plante, et bizarrement ça plante sur cette ligne de code :

MATRICE.Sheets("Alignement").Select

Sub SelectionRejet()
Dim BDD, MATRICE As Workbook
Set MATRICE = ThisWorkbook
Workbooks.Open "\\chu\Pole ELH\Achats_Generaux\00. DOCS DE TRAVAIL COMMUNS\MATRICE CCJ\BASE DE DONNEES.xlsx"
Set BDD = ActiveWorkbook

BDD.Sheets("NOTIFS & REJETS").Visible = True
BDD.Sheets("NOTIFS & REJETS").Select

Range("A2:CV500").Select
    Selection.ClearContents
MATRICE.Sheets("Alignement").Visible = True
MATRICE.Sheets("Alignement").Select

Dim cell As Range
Set colonneRang = Range(MATRICE.Sheets("Alignement").Range("C2"), MATRICE.Sheets("Alignement").Range("C65000").End(xlUp))

For Each cell In colonneRang
'on exclu le classement 1 et les formules vides (<1000) And cell.Value < 1000
If cell.Value <> 1 And cell.Offset(0, 40).Value <> 0 Then

Range(cell.Offset(0, -2), cell.Offset(0, 100)).Copy
'Selection.Copy
BDD.Sheets("NOTIFS & REJETS").Select
    Range("A65000").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
    Next

MATRICE.Sheets("Alignement").Visible = False
BDD.Sheets("NOTIFS & REJETS").Visible = False
BDD.Close SaveChanges:=True

MATRICE.Sheets("Rédaction").Select
Range("A156").Select
End Sub

Merci de l'aide que vous pourrez m'apporter.

Le 31/10/2018 à 17:21

Bonjour,

J'ai appliqué quelques modifications à la volée sur ton code, il te reste à tester (j'ai viré les ".select", inutiles) :

Sub SelectionRejet()

Dim BDD As Workbook, MATRICE As Workbook
Dim cell As Range, colonneRang As Range

Set MATRICE = ThisWorkbook
Set BDD = Workbooks.Open "\\chu\Pole ELH\Achats_Generaux\00. DOCS DE TRAVAIL COMMUNS\MATRICE CCJ\BASE DE DONNEES.xlsx"

BDD.Sheets("NOTIFS & REJETS").Range("A2:CV500").ClearContents
With MATRICE.Sheets("Alignement")
   Set colonneRang = .Range("C2:C" & .Range("C65000").End(xlUp).Row)
End With

For Each cell In colonneRang
   If cell.Value <> 1 And cell.Offset(0, 40).Value <> 0 Then Range(cell.Offset(0, -2), cell.Offset(0, 100)).Copy BDD.Sheets("NOTIFS & REJETS").Range("A65000").End(xlUp).Offset(1, 0)
Next

BDD.Close SaveChanges:=True

End Sub

PS : ton erreur provient peut-être du fait qu'il n'existe pas de feuille nommée "Alignement" dans le fichier "MATRICE" (ou que le nom est mal orthographié).

Le 31/10/2018 à 17:22

Bonjour Constant, bonjour le forum,

  • Vérifie que le classeur a bien un onglet portant le nom Alignement.
  • Vérifie ce nom caractère par caractère. Un espace avant ou un espace après peut-être ?!...
[b]

[Édition][/b]

Bonsoir Pedro, nos posts se sont croisés...

[b]

[Édition2][/b]

Bien vu Pedro. Tu ne pouvais pas sélectionner l'onglet [b]Alignement[/b] puisque le classeur actif n'était pas Matrice...]

Le 31/10/2018 à 21:12

Bon sang mais ça marche !!

Mieux et plus vite que dans ma version. Seul petit hic, dans ta version, c'est un collage complet. Dans la mienne, j'avais un collage spécial valeurs seules (sans copie des formules et des formats de cellules).

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Or dans ta ligne de code plus sophistiquée que la mienne (bidouillée à partir de l'enregistreur) je ne sais pas comment l'insérer pour que ça fonctionne.

Pour le bug, j'avais bien vérifié la syntaxe de la feuille "Alignement", donc bizarre...

Merci encore pour ton aide !

Le 01/11/2018 à 14:26

Bonjour Constant, Pedro,

tu a écrit :

j'avais un collage spécial valeurs seules (sans copie des formules et des formats de cellules)

essaye en écrivant ainsi la fin de ta sub SelectionRejet() (non testé, à vérifier) :

  For Each cell In colonneRang
     If cell.Value <> 1 And cell.Offset(, 40).Value <> 0 Then
       cell.Offset(, -2).Resize(, 103).Copy
       BDD.Sheets("NOTIFS & REJETS").Cells(Rows.Count, 1).End(3)(2).PasteSpecial -4163
     End If
  Next cell

  Application.CutCopyMode = 0

  BDD.Close SaveChanges:=True

End Sub

dhany

Le 01/11/2018 à 15:21

Bonjour,

Pour éviter un copier-coller !...

A tester.

For Each Cell In colonneRang
        If Cell.Value <> 1 And Cell.Offset(0, 40).Value <> 0 Then
            i = i + 1
            BDD.Worksheets("NOTIFS & REJETS").Cells(i, 1).Resize(, 100).Value = Cell.Offset(, -2).Resize(, 100).Value
        End If
    Next
Le 02/11/2018 à 00:33

Bonjour Pedro,

quand j'ai écrit mon post d'hier à 14:26 j'avais déjà remarqué ta nouvelle couleur schtroumpf ; la preuve : j'avais déjà mis la bonne couleur pour ton pseudo ; par contre, j'ai oublié de te féliciter ... pour ton implication, justement !

dhany

Le 02/11/2018 à 10:39
dhany a écrit :

Bonjour Pedro,

quand j'ai écrit mon post d'hier à 14:26 j'avais déjà remarqué ta nouvelle couleur schtroumpf ; la preuve : j'avais déjà mis la bonne couleur pour ton pseudo ; par contre, j'ai oublié de te féliciter ... pour ton implication, justement !

dhany

Merci bien ! Et Ausecour est dans le même cas !

Le 02/11/2018 à 10:39

'

Le 02/11/2018 à 11:22

Bonjour Pedro,

tu a écrit :

Et Ausecour est dans le même cas !

screen

ah oui, c'est vrai ! alors félicitations à Ausecour aussi !

pour ton 2ème post :

screen 2

comme les 2 heures sont identiques, le système a créé un doublon.

Le 02/11/2018 à 11:27

C'est un code, je pensais que tu trouverais tout de suite !

Spoiler

...que j'ai cité mon message précédent au lieu de le modifier !

Le 02/11/2018 à 11:33

on s'est croisés : j'viens d'ajouter que les heures étant identiques, c'est un doublon. t'as des problèmes avec ta souris ? elle fait un double-clic intempestif alors que t'as fait un simple clic ? (ça m'est déjà arrivé, à moi aussi !)

Le 02/11/2018 à 11:37

ajout : c'est vrai aussi que le bouton est pas loin du bouton

j'trouve ça bien amusant, tous ces auteurs qui adorent tellement leur propre texte

qu'ils se citent eux-même ! ... toute modestie mise à part, bien sûr !

dhany

Le 03/11/2018 à 17:56

Bonjour Dhany, Pedro, Jean-Eric...

Les 2 méthodes de paste spécial, que Dhany et Jean-Eric, vous m'avez proposées, fonctionnent. Merci à vous 3. Celle de Jean-Eric a déformé certaines lignes en les agrandissant, ce qui en soit ne pose aucun problème, les données étant destinées à être publipostées dans un Word et non à être visualisées en direct.

Dhany, à défaut d'être capable de réécrire ta ligne de code à l'aveugle, j'ai besoin de la comprendre pour pouvoir maintenir mon fichier par la suite.

Dans ton code, pourquoi 103 au lieu de 100 ? 103 est numéro de la dernière colonne à copier mais pourquoi n'est-ce pas 100 comme dans la macro de Jean-Eric ( position relative cell.Offset de ma macro d'origine : -2, 100).

D'autre part, j'avoue ne piger que couic à cette partie "End(3)(2).PasteSpecial -4163"

Pour rappel :

For Each cell In colonneRang
     If cell.Value <> 1 And cell.Offset(, 40).Value <> 0 Then
       cell.Offset(, -2).Resize(, 103).Copy
       BDD.Sheets("NOTIFS & REJETS").Cells(Rows.Count, 1).End(3)(2).PasteSpecial -4163
     End If
  Next cell

Avec ces quelques lignes de code, moi petit juriste incompétent en Excel je mets la touche finale à un long travail entrepris il y a 2 mois qui va me permettre d'automatiser la rédaction d'un grand nombre de courriers à destination d'entreprises.

Cet aboutissement n'aurait pas été possible sans l'aide d'un certain nombre d'entre vous, merci encore.

Le 03/11/2018 à 18:06

Bonjour,

Pour info la colonne CV est la colonne 100.

Sinon, ce n'est pas ma procédure qui déforme car on "copie" les valeurs. C'est le formatage de tes cellule qui en est la cause.

Bon weekend.

Cdlt.

Le 03/11/2018 à 18:23

Bonjour Constant,

cell.Offset(, -2).Resize(, 103).Copy

avec cell.Offset(, -2) : 2 colonnes à gauche de cell

donc de cette cellule à la toute dernière à droite :

y'a en tout 103 cellules (y compris cell)

BDD.Sheets("NOTIFS & REJETS").Cells(Rows.Count, 1).End(3)(2).PasteSpecial -4163

.End(3)(2).PasteSpecial -4163 est idem que :

.End(xlUp)(2).PasteSpecial xlPasteValues (en plus court)

* avec .End(3) ou .End(xlUp) : c'est la dernière ligne utilisée

* une fois qu'elle est trouvée, le (2) fait qu'c'est la ligne juste en dessous

.End(xlUp)(2) est idem que : .End(xlUp).Offset(1)

car (1) correspond à la ligne de la dernière cellule non vide trouvée

dhany

Le 03/11/2018 à 19:35

Re,

@ dhany,

Nous sommes en colonne 3. On fait un offset -2 . Nous sommes en colonne 1.

Colonne 1 resize 100

Nous sélectionnons colonne 1 à colonne 100.

100 = CV, la donnée initiale… (Range("A2:CV500")

Bon, maintenant, le sujet est pollué et ile est difficile de revenir à la question initiale…

Cdlt.

Le 03/11/2018 à 20:24

@Jean-Eric

non, j'ai bien compté ; dans le code VBA initial de l'énoncé, il y a :

Range(cell.Offset(0, -2), cell.Offset(0, 100)).Copy

donc à partir de la cellule cell en cours :

* cell.Offset(0, -2) donne 2 cellules à gauche (cell non comprise) ➯ nombre de cellules : 2

* cell.Offset(0, 100) donne 100 cellules à droite (cell non comprise) ➯ nombre de cellules : 100

* donc 2 cellules (à gauche de cell) + 100 cellules (à droite de cell) + 1 cellule (la cellule cell elle-même) :

ça fait bien 2 + 100 + 1 = 103 cellules, d'où : cell.Offset(, -2).Resize(, 103).Copy

dhany

Le 03/11/2018 à 21:50

merci à vous 2, bien compris.

Je garde ça pour faire le manuel d'entretien.

A +

Le 03/11/2018 à 22:04

merci pour ton retour !

bonne chance pour la tenue de ton manuel d'entretien !

dhany

Rechercher des sujets similaires à "bug methode select classe worksheet echoue"