Petite modification d'une macro

[salsitawapa]

Salut à tous, voila j'ai cette macro qui marche très bien :

Sub Monter()
Range("A1:A10").Select
Selection.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
Range("A1").Select
End Sub


Le soucis avec elle est que je ne peux pas selectionner moi même mes cellules à monter.
Par exemple je voudrais monter les cellules C58 jusqu'a la première cellule vide du dessus qui se trouve par exemple en C33. Comment remplacer mes Range("A1:A10").Select et Range("A1").Select par quelque chose du genre selection ou autre ? Merci

 

[JeanMarie]

Re : Petite modification d'une macro

Bonsoir

As-tu essayer en supprimant complètement la ligne
Range("A1:A10").Select

@+Jean-Marie

 

[salsitawapa]

Re : Petite modification d'une macro

Salut Jean marie, en fait se que je dois faire c'est selectionner manuellement les cellule. J'y arrive pour copier des cellules que je selectionne mannuellement :

Sub Copier()
Selection.Copy
End Sub

Pareil pour effacer :

Sub Effacer()
'Effacement de la cellule ainsi que des commentaires
Selection.ClearContents
Selection.ClearComments
End Sub

Voila je voudrai faire de même pour monter les cellules aux choix (que je selectionne manuellement et que j'active la macro).

 

[SergiO]

Re : Petite modification d'une macro

Bonsoir,

Essaie avec ceci pour choisir la sélection

Dim PlageSource As Range
 
    Set PlageSource = Application.InputBox _
        ("Sélectionnez la ou les cellule(s) à supprimer !", "Sélection Plage", Type:=8)

@+

 

[salsitawapa]

Re : Petite modification d'une macro

Bonsoir sergio, voici se que j'ai fait avec se que tu m'as donné :
Sub Monter()
Dim PlageSource As Range

Set PlageSource = Application.InputBox _
("Sélectionnez la ou les cellule(s) à supprimer !", "Plage source", Type:=8)


PlageSource.Copy
With CelluleDest
Selection.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
End With
Application.CutCopyMode = False
Exit Sub

Erreur:
If Err.Number = 424 Then Exit Sub
End Sub

Sauf que j'ai une erreur avec Selection.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp


Sais tu pourquoi ? Merci

 

[SergiO]

Re : Petite modification d'une macro

Re,

Essaie ceci

Sub Monter()
Dim PlageSource As Range

On Erreur goto Erreur

Set PlageSource = Application.InputBox _
        ("Sélectionnez la ou les cellule(s) à supprimer !", "Sélection Plage", Type:=8)
 
PlageSource.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
Range("A1").Select

Exit Sub
 
Erreur:
If Err.Number = 424 Then Exit Sub

End Sub

 

[salsitawapa]

Re : Petite modification d'une macro

Toujours le débogage avec cette ligne :
PlageSource.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp

Je ne vois pas pourquoi...

 

[SergiO]

Re : Petite modification d'une macro

Re,

J'ai testé chez moi, ça marche !!!

 

[salsitawapa]

Re : Petite modification d'une macro

J'ai trouvé pourquoi, je ne prenai pas le blanc !!!
Sa fonctionne impécablement bien !
Merci

 

[salsitawapa]

Re : Petite modification d'une macro

Petite dernière question, mes cellules que je monte enlève la mise en forme (les bordures),comment faire pour laisser les bordures et juste monter le texte et commentaires des cellules ?
Merci

 

[salsitawapa]

Re : Petite modification d'une macro

Autre chose encore, c'est que quand j'exécute la macro, elle me monte toutes les lignes, même celles que je ne selectionne pas. Y a t'il un moyen de ne pas faire monter les cellules non selectionnée ? Merci

 

[salsitawapa]

Re : Petite modification d'une macro

Bonjour à tous, voici le résultat pour monter les cellules sans me remonter celles qui ne sont pas sélectionnée. Le problème est que la boite de dialogue ne fonctionne plus et pourtant elle n'a pas était touchée.
Voici le code :

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

Est-ce que quelqu'un sait pourquoi ? Merci