Erreur 9

Le 19/07/2019 à 16:43

bonjour,

Je veux améliorer la macro que j'ai faite mais j'ai une erreur 9 qui apparait que je ne comprends pas Je ne suis pas dans les dimensions du tableau. Le code est petit et vous aurez vite compris de quoi il s'agit.

Voici le code :

Sub Request()

Set fb = Sheets("Base")

Set ft = Sheets("Trimestriel")

Dim Ws As Worksheet

Set Ws = Worksheets("Feuil1")

derln = fb.Range("B" & Rows.Count).End(xlUp).Row

Dim sPathFic As String

' Copier la feuille dans un nouveau classeur

Sheets("Base").Copy

With ActiveWorkbook.ActiveSheet

.Name = "Samples Request"

On Error Resume Next ' Si aucune ligne vide

.Shapes("Request").Delete

.Range("D13:D800").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

On Error GoTo 0

End With

For i = 5 To fb.Range("B" & Rows.Count).End(xlUp).Row

ft.Range("D" & i) = ft.Range("D" & i) + fb.Range("D" & i)

ft.Range("D" & i) = IIf(ft.Range("D" & i) = 0, "", ft.Range("D" & i))

Next i

Worksheets("Feuil1").Activate

Columns("D:D").Select

Selection.ClearContents

Columns("E:E").Select

Selection.ClearContents

Range("C3:C9,G1:G9").Select

Selection.ClearContents

Range("B528:D535").Select

Selection.ClearContents

ActiveSheet.Range("E17").Select

End Sub

L'erreur survient à la ligne suivante :

Set Ws = Worksheets("Feuil1")

Pouvez-vous m'aider ?

Rom

Le 19/07/2019 à 16:57

Bonjour,

Il y aurait toutes les chances pour que l'erreur survienne sur cette ligne:

Worksheets("Feuil1").Activate

puisqu'on est alorts positionné sur le classeur créé par la ligne Sheets("Base").Copy, et que ce classeur ne contient pas de feuille Feuil1.

Pour y remédier, un remède possible:

Set Ws = ActiveWorkbook.Worksheets("Feuil1") au lieu de Set Ws = Worksheets("Feuil1")

et

Ws.Activate au lieu de Worksheets("Feuil1").Activate

A+

Le 22/07/2019 à 11:30

Bonjour AlgoPlus,

Merci pour ton aide.

Donc j'ai toujours la même erreur avec ta proposition :

Sub Request()

Set fb = Sheets("Base")

Set ft = Sheets("Trimestriel")

Dim Ws As Worksheet

Set Ws = ActiveWorkbook.Worksheets("Feuil1")

derln = fb.Range("B" & Rows.Count).End(xlUp).Row

Dim sPathFic As String

' Copier la feuille dans un nouveau classeur

Sheets("Base").Copy

With ActiveWorkbook.ActiveSheet

.Name = "Samples Request"

On Error Resume Next ' Si aucune ligne vide

.Shapes("Request").Delete

.Range("D13:D800").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

On Error GoTo 0

End With

For i = 5 To fb.Range("B" & Rows.Count).End(xlUp).Row

ft.Range("D" & i) = ft.Range("D" & i) + fb.Range("D" & i)

ft.Range("D" & i) = IIf(ft.Range("D" & i) = 0, "", ft.Range("D" & i))

Next i

Worksheets("Feuil1").Activate

Columns("D:D").Select

Selection.ClearContents

Columns("E:E").Select

Selection.ClearContents

Range("C3:C9,G1:G9").Select

Selection.ClearContents

Range("B528:D535").Select

Selection.ClearContents

ActiveSheet.Range("E17").Select

End Sub

En fait le fichier initial répertorie tous les echantillons en stock.

Dès que j'ai besoin de faire une demande je sélectionne les échantillons et donc la macro doit me faire :

  • Créer un nouveau fichier avec les echantillons sélectionnés que je vais sauvegarder.
  • Additionner ces echantillons dans un autre onglet de la feuille initiale.
  • Nettoyer la feuille initiale pour pouvoir recommencer les demandes.

J'ai mis en PJ mon fichier pour être plus claire.

Le but étant de n'utiliser qu'un seul bouton au lieu de deux.

8fichier-test.xlsm (69.77 Ko)
Le 22/07/2019 à 11:59

Désolé, impossible de lire le classeur même avec le convertisseur pour ma version XL2003.

L'erreur intervient sur Set Ws = ActiveWorkbook.Worksheets("Feuil1") ??

la feuille Feuil1 existe-t-elle ?

Le 22/07/2019 à 12:03

Oui la feuille 1 s'appelle Base et répertoriée comme Feuil1

Le 22/07/2019 à 12:09

J'ai mis un screenshot si cela peut aider.

capture d ecran 2019 07 22 a 12 08 09
Le 22/07/2019 à 12:19

Bonjour à tous,

Un essai ...

Option Explicit

Sub Request()
Dim MonClasseur As String
Dim fb As Worksheet
Dim ft As Worksheet
Dim Ws As Worksheet
Dim derln As Integer, i As Integer
Dim sPathFic As String

    MonClasseur = ActiveWorkbook.Name
    Set fb = Sheets("Base")
    Set ft = Sheets("Trimestriel")

    Set Ws = ActiveWorkbook.Worksheets("Base")
    derln = fb.Range("B" & Rows.Count).End(xlUp).Row

    ' Copier la feuille dans un nouveau classeur
    Sheets("Base").Copy
    With ActiveWorkbook.ActiveSheet
        .Name = "Samples Request"
        On Error Resume Next  ' Si aucune ligne vide
        .Shapes("Request").Delete
        .Range("D13:D800").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        On Error GoTo 0
    End With
    For i = 5 To fb.Range("B" & Rows.Count).End(xlUp).Row
        ft.Range("D" & i) = ft.Range("D" & i) + fb.Range("D" & i)
        ft.Range("D" & i) = IIf(ft.Range("D" & i) = 0, "", ft.Range("D" & i))
    Next i
    Workbooks(MonClasseur).Activate
    Worksheets("Base").Activate
    Columns("D:D").ClearContents
    Columns("E:E").ClearContents
    Range("C3:C9,G1:G9").ClearContents
    Range("B528:D535").ClearContents
    ActiveSheet.Range("E17").Select
End Sub

ric

Le 22/07/2019 à 12:21

Bonjour

L'erreur survient à la ligne suivante :

Set Ws = Worksheets("Feuil1")

Feuil1 = codeName

mettre tout simplement le codeName

    Set Ws = Feuil1

A+

Maurice

Le 22/07/2019 à 12:27

Super Algo Sup, Ric et Archer pour votre aide les deux fonctionnent.

Bonne journée et bonnes vacances.

Rechercher des sujets similaires à "erreur"