Sélectionner plusieurs lignes conditions

[eillon]

BOnjour,

Voici une macro qui me permet de sélectionner les lignes correspondantes à la région parisienne (fonction du numéro département).

Sub select()
 
'déclaration des variables
' ------------------------
Dim numligne As Long
Dim départ As Integer
Dim numl As Integer
Dim n As Integer
 
 
 
 
' TRAITEMENT
' ----------
Application.ScreenUpdating = False
Sheets.Add.Name = "région parisienne"
 
Sheets("Fichier unique Antony").Select
numligne = 2
numl = 2
n = 1
Do
     départ = Int(Range("E" & numligne) / 1000)
     Select Case départ
          Case 2, 8, 10, 14, 18, 21, 22, 27, 28, 29, 35 To 37, 41, 44, 45, 49, 50 To 62, 67, 68, 70, 72, 76, 79 To 80, 85, 86, 88 To 90
' ne rien effacer
Case Else
               Range(numligne & ":" & numligne).Select
               x = x + 1
               Selection.Copy Sheets("Région parisienne").Range("A" & x)
               n = n + 1
               
End Select
      numligne = numligne + 1
Loop Until Range("E" & numligne) = ""
 
Application.ScreenUpdating = True
 
derniereLigne = ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
For r = derniereLigne To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r
 
    Range("A1").End(xlDown).Offset(1, 0).Select
    
 End Sub

J'aimerai pouvoir sélectionner les départements par une msgbox pour sélectionner les départements qui m'intéressent et modifier par la même occasion le nom de la nouvelle feuille...

 

[eillon]

Re : Sélectionner plusieurs lignes conditions

personne n'aurais une petite idée ?

 

[eillon]

Re : Sélectionner plusieurs lignes conditions

Je m'approcherai bien du résultat avec ça, la nouvelle feuille est créée, mais les lignes choisi ne sont pas copier dans cette nouvelle feuille.

Sub saisie()

Dim numligne As Long
Dim depts As Integer
Dim n As Integer
Dim s As String
Dim deps() As String
Dim NomReg As String

numligne = 1
n = 1


     depts = Int(Range("E" & numligne) / 1000)
        
   
        s = InputBox("Veuillez saisir les N° des départements, séparés par des virgules :")
        deps = Split(s, ",")
   
       s = InputBox("Veuillez saisir un nom pour la nouvelle feuille :")
       NomReg = s
        CopieParDepartement deps, NomReg
                 
              
End Sub

Sub CopieParDepartement(deps() As String, NomReg As String)
      
Dim numligne As Long
Dim depts As Integer
Dim n As Integer
Dim s As String

Sheets.Add.Name = NomReg

      
      

               Selection.Copy Sheets = NomReg.Range("A" & x)
               n = n + 1
               
End Sub

 

[Cousinhub]

Re : Sélectionner plusieurs lignes conditions

Bonjour,
ce qui nous gêne, ce n'est pas trop le code, mais surtout, tout le fichier à créer pour faire des essais
De plus, qu'entends-tu par "Région Parisienne"? (c'est vaste)
Si tu pouvais joindre un fichier exemple, on pourrait travailler plus aisément.

 

[eillon]

Re : Sélectionner plusieurs lignes conditions

Voilà le fichier joint, je souhaite pouvoir copier les lignes dans une nouvelle feuille en fonction de leurs départements (en ne sélectionnant que les 2 chiffres, pas tout le code postal).

 

[Cousinhub]

Re : Sélectionner plusieurs lignes conditions

Re-,
ton fichier en pièce jointe
Note sur la feuille 2, et sur la feuille 1 les titres
ils doivent être rigoureusement identiques sur les 2 feuilles si tu les changes
Je n'ai pas adopté ta solution "InputBox", mais un usf, avec ListBox multi-sélection
Tu peux sélectionner plusieurs départements, l'extraction se fera sur ces départements
clique sur le rectangle jaune....
J'ai aussi inséré un nom "base"
regarde dans Insertion/Nom/Définir

 

[eillon]

Re : Sélectionner plusieurs lignes conditions

En fait c'est plutôt sympa, mais je ne peux choisir qu'un seul département.
De plus, il me faut l'adapter sur plusieurs classeurs.
C'est pour ça que j'aurais préféré une macro.

 

[Cousinhub]

Re : Sélectionner plusieurs lignes conditions

Re-,
as-tu essayé?
Clique sur 45, puis 90, puis 95, tu auras alors les 3 départements de sélectionnés dans la ListBox, et l'extraction se fera sur ces 3 départements

quoique maintenant, je me demande si mon excel est le même que tout le monde (référence à un autre souci avec un autre fichier)

Et il est facilement adaptable, il suffit de rajouter la zone nommée "base", de mettre les bons noms de feuille dans le code, de remplacer à la rigueur la colonne qui contient le code postal, et le tour est joué.

 

[eillon]

Re : Sélectionner plusieurs lignes conditions

Petit problème, je tourne sous excel 2007, je ne trouve pas insertion, nom, base.

 

[eillon]

Re : Sélectionner plusieurs lignes conditions

je n'arrive pas à le mettre en place sur mon fichier, ça plante sur

Range("base").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range( _
    "J1:J" & derlig), CopyToRange:=.Range("A1:H1"), Unique:=False
.Columns("J:J").ClearContents

J'ai beau changer le nom des feuilles, le nom de l'userform, la première ligne, rien n'y fait...

J'ai toujours une demande me mise à jour du fichier.

 

[eillon]

Re : Sélectionner plusieurs lignes conditions

EN fait quand je reprend cette macro, je ne doit pas être bien loin mais je ne sais pas l'adapter à mes besoins.

Sub Aj_feuil()
'nom = variable qui va contenir les caractères communs au nom de chaque feuille. Vous pouvez le modifier.
'Si vous ne voulez que les numéros, vous pouvez supprimer les lettres et ne laisser que les guillemets.
nom = "F"
 
'1ère ligne contenant les données (vous pouvez modifier)
pl = 1
'colonne contenant les données (vous pouvez modifier)
c = 1
'Recherche de la dernière ligne contenant les données
Set mf = Worksheets("Fichier unique Antony")
dl = mf.range("A65536").End(xlUp).Row
'tri du fichier sur la colonne "A"
 
mf.range("A1:H" & CStr(dl)).Sort _
    Key1:=mf.range("A1")
'initialisation de la variable qui va contenir le nom définitif de la feuille soit : le nom concaténé avec le numéro
'tranformé en texte. Ne pas modifier
numv = 0
Application.ScreenUpdating = False
Dim message, titre, text
message = "Entrez la valeur de début et la valeur de fin séparées par un espace" & Chr(10) & Chr(13) & _
"et en milliers, par exemple : 250 280 " & Chr(10) & Chr(13) & _
"les valeurs prisent en compte seront " & Chr(10) & Chr(13) & _
"250 000 à 280 999" & Chr(10) & Chr(13) & _
"Si vous cliquez sur Annuler la procédure sera abandonnée"
 
Saisie:
 
titre = "Valeur à traiter"
text = InputBox(message, titre)
 
If text = "" Then
Exit Sub
End If
  
    Tableau = Split(text, " ")
        
    For i = 0 To UBound(Tableau)
        If i = 0 Then
        n1 = Tableau(i)
        v1 = Val(Tableau(i) & "000")
        Else
        n2 = Tableau(i)
        v2 = Val(Tableau(i) & "999")
        End If
    Next i
If v1 > v2 Then
MsgBox "les valeurs entrées ne sont pas valables, recommencez ou cliquez sur annuler"
GoTo Saisie
End If
 
 
For n = pl To dl
numv = mf.Cells(n, c)
If numv < v1 Then
    If n = dl Then
    MsgBox "Aucun enregistrement correspondant n'a été trouvé"
    Exit Sub
    End If
Else
Exit For
End If
Next n
 
 
 
pl = n
numl = 1
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = nom & n1 & "_" & n2
mf.Activate
 
For n = pl To dl
numv = mf.Cells(n, c)
If numv > v2 Then
 
message = "Entrez la valeur de début et la valeur de fin séparées par un espace" & Chr(10) & Chr(13) & _
"et en milliers, par exemple : 250 280 " & Chr(10) & Chr(13) & _
"les valeurs prisent en compte seront " & Chr(10) & Chr(13) & _
"250 000 à 280 999" & Chr(10) & Chr(13) & _
Chr(10) & Chr(13) & _
"Pour terminer le traitement cliquez sur Annuler"
pl = n
GoTo Saisie
Exit For
End If
 
 
If numv > v1 And numv < v2 Then
mf.Rows(n).Copy Sheets(nom & n1 & "_" & n2).Rows(numl)
numl = numl + 1
End If
Next n
 
Application.ScreenUpdating = True
End Sub

 

[Cousinhub]

Re : Sélectionner plusieurs lignes conditions

Bonjour,
en reprenant mon raisonnement, dans le fichier joint, la zone nommée base est créée automatiquement

 

[eillon]

Re : Sélectionner plusieurs lignes conditions

Je me retrouve toujours avec la même demande.
Pièces jointe.

 

[Cousinhub]

Re : Sélectionner plusieurs lignes conditions

Bonjour,
le problème n'est plus le même, c'est l'adaptation à ton fichier qui pose problème
Vérifie bien les noms de d'onglet, au pire, renomme les comme ceci :
"Feuil1", "Feuil2"..... et regarde
Sinon, est-ce que tu commences bien en A1?
regarde la définition de la plage nommée "base", et remplace à la rigueur "Database" par "base", et rajoute ce qui est en vert

Private Sub CommandButton1_Click()
[COLOR="SeaGreen"]With Sheets("Feuil1")[/COLOR]
Dim pl As Range
Set pl = [COLOR="SeaGreen"].[/COLOR]Range("A1:H" & [COLOR="SeaGreen"].[/COLOR]Range("A65536").End(xlUp).Row)
pl.Name = "[COLOR="Red"]Database[/COLOR]"
[COLOR="SeaGreen"]End With[/COLOR]
With Sheets("Feuil2")
For i = 0 To Me.ListBox1.ListCount - 1
    If Me.ListBox1.Selected(i) = True Then
        derlig = IIf(.[J65000].End(xlUp).Row = 1, 2, .[J65000].End(xlUp).Row + 1)
        .Cells(derlig, 10).Formula = "=LEFT(Feuil1!E2,2)=""" & Me.ListBox1.List(i) & """"
    End If
Next
Range("base").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range( _
    "J1:J" & derlig), CopyToRange:=.Range("A1:H1"), Unique:=False
.Columns("J:J").ClearContents
End With
Unload Me
End Sub

Attention aux petits points devant .Range("......