Problème de relation entre subs simples

Version imprimable

Bonjour,

J'ai un fichier de test très simple avec une plage de cellules nommée qui contient des nombre dans les X cases du haut. J'ai réussi à faire une macro (sans paramètre) qui donne la X+1ème cellule mais quand j'utilise une autre macro ayant en paramètre la plage dont on veut trouver la première case vide j'ai un problème. J'ai cherché moi-même et puis partout sur le net et je n'ai pas réussi à trouver quelque chose qui règle les différentes erreurs. voilà le code (dans mon fichier I8:I16 est nommé toto) :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 Option Explicit Public toto As Range Function dernière(pipo As Range) 'Static toto As Range 'Static pipo As Range 'Application.EnableEvents = False pipo.End(xlDown).Select ActiveCell.Offset(1, 0).Range("A1").Select dernière = Selection 'Application.EnableEvents = True End Function Sub écrit() MsgBox = dernière.Offset(-1, 0).Value End Sub Sub plop() Call dernière(toto) End Sub Function dernièreSIMPLE() 'Range("I8:I16").End(xlDown).Select 'ActiveCell.Offset(1, 0).Range("A1").Select 'dernièreSIMPLE = Selection dernièreSIMPLE = Range("I8:I16").End(xlDown).Offset(1, 0).Select End Function
Le problème doit très certainement être simple. J'ai supposé que c'était lié au formats mais je n'ai pas trouvé. Et j'ai pensé qu'il faudra que je vérifie ce qu'il se passe quand la plage est vide une fois la macro fonctionnera.
PS : les lignes de commentaires sont liées aux différentes solutions que j'ai essayé pour traiter le problème.

Merci si vous pouvez me filer un petit coup de main.

Bonjour,

sans fonction :

Code:

1
2
3
4
5
6
Sub Test()
Dim LaPlage As Range
    Set LaPlage = ThisWorkbook.Worksheets("Feuil1").Range("TOTO")
    MsgBox LaPlage.Address
    MsgBox LaPlage.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Address
End Sub

si tu dois réutiliser ça dans pas mal de procédure, inspire toi de cet exemple qui travaille sur l'objet Range :

Code:

1
2
3
4
5
6
7
8
9
10
11
Sub TestAvecFonction()
Dim LaPlage As Range
Dim LaDerniereCellule As Range
    Set LaPlage = ThisWorkbook.Worksheets("Feuil1").Range("TOTO")
    Set LaDerniereCellule = LaDerniere(LaPlage)
    MsgBox LaDerniereCellule.Address
End Sub
 
Function LaDerniere(Plage As Range) As Range
Set LaDerniere = Plage.SpecialCells(xlCellTypeLastCell).Offset(1, 0)
End Function

Bonjour et un grand merci joe levrai, je m'excuse pour le retard j'étais pris par le boulot.
Tu as réglé plusieurs problèmes. Ton code fonctionne parfaitement et répond exactement à mon besoin une fois remplacé "SpecialCells(xlCellTypeLastCell)" par "End(xlDown)" dans le petit fichier test.
Cependant que j'utilise une des deux versions dans mon code, ça ne fonctionne plus (2 erreurs différentes).
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 Function Derniere(Plage As Range) As Range Set Derniere = Plage.End(xlDown).Offset(1, 0) End Function Sub Piocher(NbCarte As Integer) Dim LaPlage As Range Dim LaDerniereCellule As Range Set LaPlage = ThisWorkbook.Worksheets("Feuil1").Range("Main") Set LaDerniereCellule = Derniere(LaPlage) Dim i As Integer For i = 1 To NbCarte Range("C6").Cut LaDerniereCellule.Paste Range("C7:C65").Cut Range("C6:C64").Paste Next Application.CutCopyMode = False End Sub
"Main" est une plage définie de la même manière que celle qui fonctionne avec ton exemple. (le nom de "Main" ne pose pas de problème car j'ai les même erreurs en le changeant)
Je ne vois pas d'où vient l'erreur car comme je le pense et comme tu l'as fait remarqué dans ta réponse, on travaille avec des range.
J'ai donc peur que ta réponse ne me suffise pas.

15/01/2016, 14h46
joe.levrai

Bonjour,

quel est le message d'erreur, et sur quelle ligne ?

ta plage Main contient au moins 2 cellules ? Cette plage dispose-t-elle encore d'une cellule vide ou tout est rempli ? D'ailleurs, comment est définie ta plage dans Excel (dynamiquement ou avec une plage totalement fixe)

pourquoi le specialcells a dû être modifié par un End(XlDown) ?

Ps : ceci n'est pas un interrogatoire :ptdr:
15/01/2016, 15h03
jeunePadawan

Alors voilà les réponses à tes questions dans l'ordre :

1) avec End(xldown) : 1004 erreur définie pas l'application ou par l'objet à la ligne Set Derniere = Plage.End(xlDown).Offset(1, 0).
avec SpecialCells(xlCellTypeLastCell) : 438 Propriété ou méthode non gérée par cet objet à la ligne LaDerniereCellule.Paste.

2)la mplage Main contient 14 cellules
elles sont vides pour le moment (elles se rempliront avec la pioche), en remplir une ne change rien à l'erreur
la plage est définie de manière fixe

3) avec SpecialCells ça me retournait la cellule sous la plage et non la première cellule vide DANS la plage.

Encore merci pour la fulgurance de tes réponses !

Et voilà un code (non optimisé à mon avis vu le nombre de select et les copier-coller-suppr) qui fonctionne.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
Function Derniere(Plage As Range) As Range
 
    'Dim debut As Range
    'Set debut = Range("E6")
 
    Set Derniere = Plage.End(xlDown).Offset(1, 0)
 
End Function
 
 
Sub Piocher(NbCarte As Integer)
 
    Dim LaPlage As Range
    Dim LaDerniereCellule As Range
    Set LaPlage = Range("E6")  'ThisWorkbook.Worksheets("Feuil1").Range("Main")
 
    Application.CutCopyMode = False
 
    Dim i As Integer
 
    For i = 1 To NbCarte
 
        Set LaDerniereCellule = Derniere(LaPlage)
 
        Range("C6").Select
        Selection.Copy
        LaDerniereCellule.Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
        Range("C7:C65").Select
        Selection.Copy
        Range("B6").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
        Range("C6:C65").Select
        Selection.ClearContents
 
        Range("B6:B64").Select
        Selection.Copy
        Range("C6").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
        Range("B6:B64").Select
        Selection.ClearContents
    Next
 
    Range("Q10").Select
 
End Sub
 
Sub Départ()
 
    Application.ScreenUpdating = False
 
    'on vide tout les emplacements
    Range("Deck").ClearContents
    Range("Main").ClearContents
    Range("Champ").ClearContents
    Range("Cimetière").ClearContents
    Range("Exile").ClearContents
    Range("Réserve").ClearContents
 
    'on remplit le deck
    Dim i As Integer
    For i = 1 To 60
        Range("C" & 5 + i).Value = i
    Next
 
    Call Mélange
 
    Piocher (7)
 
    Application.ScreenUpdating = True
 
End Sub
 
Sub Mélange()
 
    Application.ScreenUpdating = False
 
    Range("C6:D65").Select
    Selection.AutoFilter
    Selection.AutoFilter       'si je retire cette ligne les flèches de tri reste à la fin de la procédure
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("D6:D65") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range("C6:D65")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
    Range("Q5").Select
 
    Application.ScreenUpdating = True
 
End Sub

Le seul problème est que cela ne marche pas quand la "main" (E6 et les suivantes) est vide. J'y travaille

Merci encore pour le coup de main.