Erreur sur boite de dialogue

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
 

salsitawapa

XLDnaute Occasionnel
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
 

Statistiques des forums

Discussions
312 492
Messages
2 088 910
Membres
103 983
dernier inscrit
AlbertCouillard