OVH Cloud OVH Cloud

aide sur macro

1 réponse
Avatar
alroussel
Bonjour à tous,
En consultant les différent sites j'ai trouvé une macro qui consiste à
supprimer les lignes lorsque qu'une cellule de cette ligne est vide.
En application très fier de moi j'ai construit une macro pour permettre à un
utilisateur, à partir d'une liste, de sélectionner des personnes en
indiquant simplement le nombre de critères auxquels il veut que ces
personnes répondent.Les critères se trouvent dans les colonnes L à AD et
s'éatage toujours comme suit année puis nom du critère correspondant.
En fait cette sélection revient à sélectionner la colonne N+1 "nom du
critère" ou n est le choix de l'utilisateur et d'éliminer les lignes où
cette colonne est vide.
Mais voilà elle me joue un petit tour que malgré mes recherches je n'arrive
pas à résoudre:
En effet, elle fonctinne bien lorsque l'on répond 1 ou 2 à l'imputbox mais
dès que l'on met 3 alors un message apparait disant textuellement ceci:
" impossible d'utiliser cette commande sur des sélection qui se superposent"


Pour toutes explications voilà ma macro (attention elle est longue on peut
peut-être la simplfier) mais je suis un débutant mais vous comprendrez
certainement où est la faille
merci d'avance
Je voudrais conserver le sens de cette macro

Alain

ma macro:

Sub programmation()
Dim Nbr
'création feuille programmation par copie de la liste dans une nouvelle
feuille
Sheets("Liste").Select
ActiveSheet.Copy After:= _
Workbooks("selection mcir.xls").Sheets(Workbooks("selection
mcir.xls").Sheets.Count)
Sheets("Liste (2)").Select
Sheets("liste (2)").Name = "Programmation"

'etablissement de la liste suivant le nombre de critère

' choix au moins x critères soit nbr=x

Nbr = InputBox("Vous allez pouvoir établir une liste de personnes" _
& Chr(13) & "répondant au nombre minimun de critères" _
& Chr(13) & "que vous aurez choisi." _
& Chr(13) & Chr(13) & "INDIQUER CI-DESSOUS LE NOMBRE DE CRITERES" _
& Chr(13) & "( ce nombre peut varier de 1 à 10 )" _
& Chr(13) & Chr(13) & "Nombre de critères", "PROGRAMMATION")
'si pas de nombre
If Nbr = "" Then
MsgBox "aucun nombre n'a été indiqué." _
& Chr(13) & "Toute l'opération de programmation est" _
& Chr(13) & "annulée."
Sheets("programmation").Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Sheets("repertoire").Select
Range("e3").Select
Exit Sub
End If
'sélection suivant nombre indiqué
If Nbr = "1" Then
Call nombre1
End If
If Nbr = "2" Then
Call nombre2
End If
If Nbr = "3" Then
Call nombre3
End If
If Nbr = "4" Then
Call nombre4
End If
If Nbr = "5" Then
Call nombre5
End If
If Nbr = "6" Then
Call nombre6
End If
If Nbr = "7" Then
Call nombre7
End If
If Nbr = "8" Then
Call nombre8
End If
If Nbr = "9" Then
Call nombre9
End If
If Nbr = "10" Then
Call nombre10
End If

MsgBox "Voilà votre liste est établie" _
& Chr(13) & Chr(13) & "A VOUS DE JOUER !!!"
Sheets("repertoire").Select
Range("e3").Select

End Sub

Sub nombre1()
With Range("L1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre2()
With Range("N1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre3()
With Range("P1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre4()
With Range("R1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre5()
With Range("T1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre6()
With Range("V1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre7()
With Range("X1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre8()
With Range("Z1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre9()
With Range("AB1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre10()
With Range("AD1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

1 réponse

Avatar
Philippe.R
Bonsoir,
La réponse de à 18h12 ne convient pas ?
--
Amicales Salutations

Retirer A_S_ pour répondre.
XL97 / XL2002

"alroussel" a écrit dans le message de
news:3fbfc2c0$0$9309$
Bonjour à tous,
En consultant les différent sites j'ai trouvé une macro qui consiste à
supprimer les lignes lorsque qu'une cellule de cette ligne est vide.
En application très fier de moi j'ai construit une macro pour permettre à un
utilisateur, à partir d'une liste, de sélectionner des personnes en
indiquant simplement le nombre de critères auxquels il veut que ces
personnes répondent.Les critères se trouvent dans les colonnes L à AD et
s'éatage toujours comme suit année puis nom du critère correspondant.
En fait cette sélection revient à sélectionner la colonne N+1 "nom du
critère" ou n est le choix de l'utilisateur et d'éliminer les lignes où
cette colonne est vide.
Mais voilà elle me joue un petit tour que malgré mes recherches je n'arrive
pas à résoudre:
En effet, elle fonctinne bien lorsque l'on répond 1 ou 2 à l'imputbox mais
dès que l'on met 3 alors un message apparait disant textuellement ceci:
" impossible d'utiliser cette commande sur des sélection qui se superposent"


Pour toutes explications voilà ma macro (attention elle est longue on peut
peut-être la simplfier) mais je suis un débutant mais vous comprendrez
certainement où est la faille
merci d'avance
Je voudrais conserver le sens de cette macro

Alain

ma macro:

Sub programmation()
Dim Nbr
'création feuille programmation par copie de la liste dans une nouvelle
feuille
Sheets("Liste").Select
ActiveSheet.Copy After:= _
Workbooks("selection mcir.xls").Sheets(Workbooks("selection
mcir.xls").Sheets.Count)
Sheets("Liste (2)").Select
Sheets("liste (2)").Name = "Programmation"

'etablissement de la liste suivant le nombre de critère

' choix au moins x critères soit nbr=x

Nbr = InputBox("Vous allez pouvoir établir une liste de personnes" _
& Chr(13) & "répondant au nombre minimun de critères" _
& Chr(13) & "que vous aurez choisi." _
& Chr(13) & Chr(13) & "INDIQUER CI-DESSOUS LE NOMBRE DE CRITERES" _
& Chr(13) & "( ce nombre peut varier de 1 à 10 )" _
& Chr(13) & Chr(13) & "Nombre de critères", "PROGRAMMATION")
'si pas de nombre
If Nbr = "" Then
MsgBox "aucun nombre n'a été indiqué." _
& Chr(13) & "Toute l'opération de programmation est" _
& Chr(13) & "annulée."
Sheets("programmation").Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Sheets("repertoire").Select
Range("e3").Select
Exit Sub
End If
'sélection suivant nombre indiqué
If Nbr = "1" Then
Call nombre1
End If
If Nbr = "2" Then
Call nombre2
End If
If Nbr = "3" Then
Call nombre3
End If
If Nbr = "4" Then
Call nombre4
End If
If Nbr = "5" Then
Call nombre5
End If
If Nbr = "6" Then
Call nombre6
End If
If Nbr = "7" Then
Call nombre7
End If
If Nbr = "8" Then
Call nombre8
End If
If Nbr = "9" Then
Call nombre9
End If
If Nbr = "10" Then
Call nombre10
End If

MsgBox "Voilà votre liste est établie" _
& Chr(13) & Chr(13) & "A VOUS DE JOUER !!!"
Sheets("repertoire").Select
Range("e3").Select

End Sub

Sub nombre1()
With Range("L1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre2()
With Range("N1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre3()
With Range("P1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre4()
With Range("R1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre5()
With Range("T1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre6()
With Range("V1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre7()
With Range("X1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre8()
With Range("Z1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre9()
With Range("AB1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre10()
With Range("AD1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub