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
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
j
pas bien compris ce que tu veux faire, mais tu devrais essayer de faire un seul sub nombre(num) plutot que nombre1, nombre2, nombre3... tu pourras remplacer
If Nbr = "1" Then Call nombre1 End If If Nbr = "2" Then Call nombre2 End If If Nbr = "3" Then par :
for num=1 to 10 call nombre(num) next
pour ce qui est de ton plantage, je ne suis pas sur que ta syntaxe soit correcte, essaie plutot Sub nombre2() With Range(range("N1"), Range("A65000").End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete End With End Sub et profites-en pour supprimer le with qui n'ets pas utile puisque tu n'as qu'une commande : Sub nombre2() Range(range("N1"), Range("A65000").End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete End Sub
et puis si tu mets un seul sub : Sub nombre(num) range(range("j1").offset(0,2*num),Range("A65000").End(xlUp)).SpecialCells(xl CellTypeBlanks).EntireRow.Delete End Sub
d'ailleurs, plutot que d'utiliser range, tu aurais intérêt à utiliser cells par exemple cells(1,10) pour range("j1"), ce ui t'évite éventuellement d'utiliser offset...
bon, ça va, tu es suffisamment embrouillé ?
--
http://jacxl.free.fr/
"alroussel" a écrit dans le message de news: 3fbf920b$0$18444$
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
pas bien compris ce que tu veux faire, mais tu devrais essayer de faire un
seul sub nombre(num) plutot que nombre1, nombre2, nombre3...
tu pourras remplacer
If Nbr = "1" Then
Call nombre1
End If
If Nbr = "2" Then
Call nombre2
End If
If Nbr = "3" Then
par :
for num=1 to 10
call nombre(num)
next
pour ce qui est de ton plantage, je ne suis pas sur que ta syntaxe soit
correcte, essaie plutot
Sub nombre2()
With Range(range("N1"),
Range("A65000").End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub
et profites-en pour supprimer le with qui n'ets pas utile puisque tu n'as
qu'une commande :
Sub nombre2()
Range(range("N1"),
Range("A65000").End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
et puis si tu mets un seul sub :
Sub nombre(num)
range(range("j1").offset(0,2*num),Range("A65000").End(xlUp)).SpecialCells(xl
CellTypeBlanks).EntireRow.Delete
End Sub
d'ailleurs, plutot que d'utiliser range, tu aurais intérêt à utiliser cells
par exemple cells(1,10) pour range("j1"), ce ui t'évite éventuellement
d'utiliser offset...
bon, ça va, tu es suffisamment embrouillé ?
--
J@C
http://jacxl.free.fr/
"alroussel" <alroussel@wanadoo.fr> a écrit dans le message de news:
3fbf920b$0$18444$626a54ce@news.free.fr...
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
pas bien compris ce que tu veux faire, mais tu devrais essayer de faire un seul sub nombre(num) plutot que nombre1, nombre2, nombre3... tu pourras remplacer
If Nbr = "1" Then Call nombre1 End If If Nbr = "2" Then Call nombre2 End If If Nbr = "3" Then par :
for num=1 to 10 call nombre(num) next
pour ce qui est de ton plantage, je ne suis pas sur que ta syntaxe soit correcte, essaie plutot Sub nombre2() With Range(range("N1"), Range("A65000").End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete End With End Sub et profites-en pour supprimer le with qui n'ets pas utile puisque tu n'as qu'une commande : Sub nombre2() Range(range("N1"), Range("A65000").End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete End Sub
et puis si tu mets un seul sub : Sub nombre(num) range(range("j1").offset(0,2*num),Range("A65000").End(xlUp)).SpecialCells(xl CellTypeBlanks).EntireRow.Delete End Sub
d'ailleurs, plutot que d'utiliser range, tu aurais intérêt à utiliser cells par exemple cells(1,10) pour range("j1"), ce ui t'évite éventuellement d'utiliser offset...
bon, ça va, tu es suffisamment embrouillé ?
--
http://jacxl.free.fr/
"alroussel" a écrit dans le message de news: 3fbf920b$0$18444$
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