Erreur sur boite de dialogue

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

salsitawapa

XLDnaute Occasionnel
Bonjour à tous, voila hier vous m'avez aidé pour une macro qui remontait les cellule. Le problème était que cette macro me supprimait les lignes vide et donc me remontait toute la colonne. J'ai un nouveau code qui m'évite ceci, mais le problème est que la boite de dialogue ne fonctionne plus et pourtant elle n'a pas était touchée (sauf au niveau de "On Error Resume Next").
Voici le code :
PHP:
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
 
Re : Erreur sur boite de dialogue

Sa y est j'ai trouvé l'erreur, il suffisait de mettre : Application.ScreenUpdating = True


PHP:
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
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
33
Affichages
4 K
Y
Réponses
1
Affichages
2 K
L
Réponses
1
Affichages
1 K
Lucien31
L
D
Réponses
2
Affichages
877
da silva
D
S
Réponses
4
Affichages
1 K
Stephane Da Silva
S
B
Réponses
5
Affichages
5 K
Brain Box
B
P
Réponses
12
Affichages
1 K
Pauline44
P
Réponses
7
Affichages
1 K
P
Réponses
2
Affichages
3 K
pascalmartin
P
B
Réponses
2
Affichages
1 K
bonjourdoc
B
Retour