Monter des cellules

Version imprimable

Monter des cellules

Bonsoir à tous, voila j'essaie de monter des cellules qui sont écrite pour les mettres à la place de cellules vide. J'ai ce code qui fonctionne :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 Sub Monter() Dim PlageSource As Range On Erreur GoTo Erreur Set PlageSource = Application.InputBox _ ("Sélectionner à partir des cellules vides jusqu'à la dernière cellules à monter ! ", "Sélection Plage", Type:=8) PlageSource.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp Exit Sub Erreur: If Err.Number = 424 Then Exit Sub End Sub
Le soucis avec se code est que sa me monte toutes les cellules (même celles qui ne sont pas selectionnée). Est-ce que quelqu'un sait comment faire ? Merci de vos réponse

Euh ben comme ça je dirais que c'est normal vu que tu supprimes les lignes vides... Tout le reste remonte donc automatiquement...

Si tu veux "Monter" juste tes cellules sélectionnées le mieux c'est sans doute de les couper et de les recoller.
J'ai modifié ton code de la manière suivante :

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
Sub Monter()
    Dim PlageSource As Range
    Dim wsFeuilleActive As Worksheet
    Dim wsNouvelleFeuille As Worksheet
    
    Application.ScreenUpdating = False
    
    On Error Resume Next
    
    Set wsFeuilleActive = ActiveSheet
    Set PlageSource = Application.InputBox _
    ("Sélectionner à partir des cellules vides jusqu'à la dernière cellules à monter ! ", "Sélection Plage", Type:=8)
    
'---->Ajoute une nouvelle feuille, y copie ta plage et efface les valeurs de la plage initiale

    Set wsNouvelleFeuille = Worksheets.Add
    PlageSource.Copy Destination:=wsNouvelleFeuille.Range("a1")
    PlageSource.Clear
    
'---->Efface les blancs et recopie la plage modifiée à la place de l'ancienne
    
    wsNouvelleFeuille.Range("A1", Cells(PlageSource.Rows.Count, PlageSource.Columns.Count)).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
    wsNouvelleFeuille.UsedRange.Copy Destination:=PlageSource.Cells(1, 1)
    
'---->Efface la feuille créée et réactive la première
    
    Application.DisplayAlerts = False
    wsNouvelleFeuille.Delete
    Application.DisplayAlerts = True
    
    wsFeuilleActive.Activate
    
    Application.ScreenUpdating = True
    
End Sub

Dis moi si ça correspond à ce que tu voulais

12/08/2006, 09h43
jmfmarques

D'instinct et par ce que je n'aime pas "me faire du rentre-dedans", je ferais une boucle décroissante, de la dernière cellule à la première, en supprimant au passage les cellules vides.
De cette façon, je ne risquerais pas de me faire des croche-pieds avec des modifications de position des cellules du fait de la suppression de celles qui étaient vides.
12/08/2006, 10h49
salsitawapa

Bonjour, oui sa marche, le seul soucis est que ma boite de dialogue qui s'ouvre pour sélectionner les cellules ne fonctionne plus avec la souris (pour sélectionner il faut les taper manuellement). Est-ce qu'il y a une petite modif à faire pour que l'on puisse se servir de la souris sur la boite de dialogue ?
Sinon, j'ai modifié un endroit du code pour ne pas qu'il m'efface les bordures :
Set wsNouvelleFeuille = Worksheets.Add
PlageSource.Copy Destination:=wsNouvelleFeuille.Range("a1")
PlageSource.ClearContents

Voila merci pour l'aide et si quelqu'un peut me dire comment faire pour pouvoir sélectionner avec la souris sa serai bien. Merci
12/08/2006, 11h20
SfJ5Rpw8

Citation:

Envoyé par salsitawapa

....
Voila merci pour l'aide et si quelqu'un peut me dire comment faire pour pouvoir sélectionner avec la souris sa serai bien. Merci

ben un userform et le contrôle refEdit..
12/08/2006, 12h00
salsitawapa

Bonjour, le soucis est que avant (avec le 1er code que j'ai mis), il n'y avait pas besoin de userform et refedit. Y a t'il un autre moyen pour pouvoir se reservir de la souris ? comme il était possible avec la suppression des lignes ?
Merci
12/08/2006, 13h04
conconbrr

Ben normalement si tu utilises

Code:

application.inputbox

à la place de

Code:

inputbox

alors tu peux définir le type de renvoi et sélectionner une plage avec ta souris, c'est d'ailleurs ce que tu avais à la base.

Je te conseille de révérifier ce point parceque chez moi j'arrivais très bien à sélectionner à la souris

Salut, pourtant c'est bien se que j'ai :
Code:

1 2 3 4 5 On Error Resume Next Set wsFeuilleActive = ActiveSheet Set PlageSource = Application.InputBox _ ("Sélectionner à partir des cellules vides jusqu'à la dernière cellules à monter ! ", "Sélection Plage", Type:=8)
C'est bizzard que sa ne fonctionne pas chez moi ! Je vois vraiement pas de quoi sa peut venir !!!

12/08/2006, 13h46
conconbrr

Ben là je vois pas trop vu que je n'ai pas modifié la structure de ton inputbox, il devrait marcher comme avant. Tu peux me redonner le code précis que tu utilises??

Bien sûr le voici :

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
Sub Monter()
    Dim PlageSource As Range
    Dim wsFeuilleActive As Worksheet
    Dim wsNouvelleFeuille As Worksheet
 
    Application.ScreenUpdating = False
 
    On Error Resume Next
 
    Set wsFeuilleActive = ActiveSheet
    Set PlageSource = Application.InputBox _
    ("Sélectionner à partir des cellules vides jusqu'à la dernière cellules à monter ! ", "Sélection Plage", Type:=8)
 
     'Ajoute une nouvelle feuille, y copie ta plage et efface les valeurs de la plage initiale
 
    Set wsNouvelleFeuille = Worksheets.Add
    PlageSource.Copy Destination:=wsNouvelleFeuille.Range("a1")
    PlageSource.ClearContents
 
    'Efface les blancs et recopie la plage modifiée à la place de l'ancienne
 
    wsNouvelleFeuille.Range("A1", Cells(PlageSource.Rows.Count, PlageSource.Columns.Count)).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
    wsNouvelleFeuille.UsedRange.Copy Destination:=PlageSource.Cells(1, 1)
 
      'Efface la feuille créée et réactive la première
 
    Application.DisplayAlerts = False
    wsNouvelleFeuille.Delete
    Application.DisplayAlerts = True
 
    wsFeuilleActive.Activate
 
    Application.ScreenUpdating = True
 
End Sub

Merci de ta réponse.

12/08/2006, 14h46
jmfmarques

il me semble (mais je peux me tromper...) qu'il suffit de décaler de 3 lignes vers le bas :

Citation:

Application.ScreenUpdating = False
12/08/2006, 14h58
SfJ5Rpw8

Citation:

Envoyé par jmfmarques

il me semble (mais je peux me tromper...) qu'il suffit de décaler de 3 lignes vers le bas :

bonjour jmf .... et :ccool: bien vu l'aveugle ... :mouarf:

Sa y est sa marche !!! Merci a vous tous. Voici le code corrigé, il suffisait de mettre : Application.ScreenUpdating = True

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
Sub Monter()
Dim PlageSource As Range
Dim wsFeuilleActive As Worksheet
Dim wsNouvelleFeuille As Worksheet
 
Application.ScreenUpdating = True
 
On Error Resume Next
 
Set wsFeuilleActive = ActiveSheet
Set PlageSource = Application.InputBox _
("Sélectionner à partir des cellules vides jusqu'à la dernière cellules à monter ! ", "Sélection Plage", Type:=8)
 
'Ajoute une nouvelle feuille, y copie ta plage et efface les valeurs de la plage initiale
 
Set wsNouvelleFeuille = Worksheets.Add
PlageSource.Copy Destination:=wsNouvelleFeuille.Range("a1")
PlageSource.ClearContents
 
'Efface les blancs et recopie la plage modifiée à la place de l'ancienne
 
wsNouvelleFeuille.Range("A1", Cells(PlageSource.Rows.Count, PlageSource.Columns.Count)).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
wsNouvelleFeuille.UsedRange.Copy Destination:=PlageSource.Cells(1, 1)
 
'Efface la feuille créée et réactive la première
 
Application.DisplayAlerts = False
wsNouvelleFeuille.Delete
Application.DisplayAlerts = True
 
wsFeuilleActive.Activate
 
Application.ScreenUpdating = True
 
End Sub

Voila merci !!!

12/08/2006, 15h23
SfJ5Rpw8

Citation:

Envoyé par salsitawapa

Sa y est sa marche !!! Merci a vous tous. Voici le code corrigé, il suffisait de mettre : Application.ScreenUpdating = True
...

si tu ne met jamais ScreenUpdating à false tu n'as pas besoin de le mettre à true, il est à true.. par défaut..... ..
le mettre à false permet de figer l'écran.. afin d'éviter à l'opérateur de voir l'écran bouger dans tous les sens..

Ps: merci pour les balises...
12/08/2006, 19h34
salsitawapa

Je vois se que tu veux dire. Je sais que je vois la nouvelle fenêtre se créer et se supprimer, mais il marche. Dès que je remets False, la souris ne fonctionne plus. As-tu une idée ?
Merci
12/08/2006, 19h49
SfJ5Rpw8

Citation:

Envoyé par salsitawapa

Je vois se que tu veux dire. Je sais que je vois la nouvelle fenêtre se créer et se supprimer, mais il marche. Dès que je remets False, la souris ne fonctionne plus. As-tu une idée ?
Merci

voir 5 posts plus haut ;)

Citation:

Envoyé par jmfmarques

il me semble (mais je peux me tromper...) qu'il suffit de décaler de 3 lignes vers le bas :
12/08/2006, 19h52
salsitawapa

Comment est-ce qu'il faut décaler de 3 lignes vers le bas ? Merci

Citation:

Envoyé par salsitawapa

Comment est-ce qu'il faut décaler de 3 lignes vers le bas ? Merci

:roll:

ben tu sélectionne avec la souris la ligne :

Code:

Application.ScreenUpdating = False

puis CTRL X pour couper ... tu place le curseur en dessous de la ligne
Code:

1 2 3 Set PlageSource = Application.InputBox _ ("Sélectionner à partir des cellules vides jusqu'à la dernière cellules à monter ! ", "Sélection Plage", Type:=8)
et la CTRL V pour coller ...!

en gros le morceau de code concerné devrai donner..:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 (...) Dim wsNouvelleFeuille As Worksheet On Error Resume Next Set wsFeuilleActive = ActiveSheet Set PlageSource = Application.InputBox _ ("Sélectionner à partir des cellules vides jusqu'à la dernière cellules à monter ! ", "Sélection Plage", Type:=8) Application.ScreenUpdating = True 'Ajoute une nouvelle feuille, y copie ta plage et efface les valeurs de la plage initiale Set wsNouvelleFeuille = Worksheets.Add (..)
ainsi tu ne fige l'écran qu'aprés la sélection de l'opérateur ..:mrgreen:

Ok, je n'avais pas du tout compris sa... Sa marche très bien, je te remercie bcp

Code corrigé encore une fois :

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
Sub Monter()
Dim PlageSource As Range
Dim wsFeuilleActive As Worksheet
Dim wsNouvelleFeuille As Worksheet
 
 
 
On Error Resume Next
 
Set wsFeuilleActive = ActiveSheet
Set PlageSource = Application.InputBox _
("Sélectionner à partir de la première cellule vide jusqu'à la dernière cellules à monter ! ", "Sélection Plage des cellules à monter", Type:=8)
 
Application.ScreenUpdating = False
'Ajoute une nouvelle feuille, y copie ta plage et efface les valeurs de la plage initiale
 
Set wsNouvelleFeuille = Worksheets.Add
PlageSource.Copy Destination:=wsNouvelleFeuille.Range("a1")
PlageSource.ClearContents
 
'Efface les blancs et recopie la plage modifiée à la place de l'ancienne
 
wsNouvelleFeuille.Range("A1", Cells(PlageSource.Rows.Count, PlageSource.Columns.Count)).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
wsNouvelleFeuille.UsedRange.Copy Destination:=PlageSource.Cells(1, 1)
 
'Efface la feuille créée et réactive la première
 
Application.DisplayAlerts = False
wsNouvelleFeuille.Delete
Application.DisplayAlerts = True
 
wsFeuilleActive.Activate
 
 
Application.ScreenUpdating = True
 
End Sub