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