Copie lignes sous conditions inputbox

Quelques remarques sur ce code.
Puisque tu le publies, accepte qu'il soit critiqué.  

NE PAS FAIRE DE SELECT/SELECTION. Tu peux rechercher sur ce site, je le dis systématiquement.
Ce genre de code consomme tellement de ressources que tu as été obligé de faire des ScreenUpdating.

Au lien de faire :

Truc.Select

Selection.Machin

Fais directement :

Truc.Machin

C'est la sélection, le changement de focus, le rafraichissement de tout ça, qui consomment énormément.

x n'est pas défini, ni initialisé !
r n'est pas défini !
numl n'est pas utilisé.

La division entière s'écrit \ :

MsgBox 5 \ 2

Tu utilises une boucle Do .. Loop sans vérifier la première condition.

Tu utilises la collection Sheets. Tu peux être plus précis et utiliser Worksheets.

Tu utilises une énorme condition et tu ne te sers que de l'inverse (Case Else)
Inserve-la ! La région parisienne, c'est 8 départements seulement.

Sub CopieParDepartement(dep As Integer)

    ' // Source

    Dim cell_src As Range

    Dim ws_src As Integer

 
    ' // Destination

    Dim cell_dst As Range

    Dim ws_dst As Integer

 
    Set ws_src = Worksheets("Fichier unique Antony")

    Set cell_dst = ws_src.Cells(1, 1)

 
    Set ws_dst = Worksheets.Add

    ws_dst.Name = "Departement " & dep

 
    For Each cell_src In Range(ws_src.Range("E2"), ws_src.Range("E2").End(xlDown))

    	If cell_src.Value \ 1000 = dep Then

            cell_src.EntireRow.Copy cell_dst

            Set cell_dst = cell_dst.Offset(1)

    	End If    

    Next

 
    ...

 
End Sub

C'est bon pour un département ça, mais on veut des régions :

Sub CopieParDepartement(deps() As Integer, NomReg As String)

...

    Dim dep As Variant

    Dim ok As Boolean

...

    ws_dst.Name = NomReg

...

    For Each cell_src In ..

        ok = False

        For Each dep In deps

            If cell_src.Value \ 1000 = dep Then ok = True

        Next

        If ok Then

...

Pour réaliser l'interface, conçois une UserForm, avec la liste des régions.
Fais correspondre chaque item avec des départements :

A toi maintenant de proposer une inferface pour choisir la région :

Option Base 0

 
Dim Reg_IleDeFrance(8) As Integer

Dim Reg_Picardie(3) As Integer

 
Reg_IleDeFrance(0) = 75

Reg_IleDeFrance(1) = 77

Reg_IleDeFrance(2) = 78

Reg_IleDeFrance(3) = 91

Reg_IleDeFrance(4) = 92

Reg_IleDeFrance(5) = 93

Reg_IleDeFrance(6) = 94

Reg_IleDeFrance(7) = 95

 
Reg_Picardie(0) = 2

Reg_Picardie(1) = 60

Reg_Picardie(2) = 80

 
CopieParDepartement Reg_IleDeFrance, "Région Ile de France"

PS: Dans le mesure où ton code fonctionne, je ne te impose pas de le changer, juste d'étudier ce que je propose  

merci, je commençais à désespérer, en fait je ne veux pas les mettre par région, parce que c'est moi qui défini les régions.
C'est pour ça que je veux pouvoir rentrer les départements qui m'intéressent du genre : 22, 56, 29, 44, 49.
Ils ne sont pas dans la même région, mais leur emplacement les mets ensemble.

Je suis administrateur logistique, j'ai un fichier de 1500 clients qui se maintiens (commandes, livraisons), pour faire les tournées des chauffeurs, je choisis des zones, ce qui me permet de ne pas mettre les 1500 clients sur la carte.

Je trouve que inputbox pourrait m'aider et me faire gagner du temps parce que pour le moment, je fais des copier coller dans mon classeur excel.

Pour être honnête, ce n'est pas moi qui est fais la macro, elle m'a été donnée sur un forum.
Je suis nul en vba, en fait je ne sais faire que le plus simple ou adapter celles déjà faites.

E fait, je cherche quelqu'un qui pourrait me la faire... C'est pas très cool mais je n'ai pas les moyens de me pencher dessus pour le moment et surtout pas le temps.
En passant, je cherche des bouquins bien fait pour apprendre.

Merci pour ton aide.

Je n'ai pas (plus) de bouquins à te conseiller, mais d'autres peuvent le faire.  

Et surtout ne dit pas trop fort que tu ne cherches qu'à faire faire ton boulot ! C'est très mal vu ici. Si le modo te surprend...

---------------------

Es-tu capable de faire un UserForm ?
C'est plutôt facile.

Les regroupements sont-ils toujours les mêmes ?
Ou toujours différents ?

Merci, je veux bien me lancer à faire la macro, je prendrais le temps.
Juste je voudrais connaitre la manip pour inputbox.
Je voudrais savoir comment je peux rentrer les numéros de départements pour les copier dans une nouvelle feuille.

 

Prends le soin de modifier un peu la première procédure :

Sub CopieParDepartement(deps() As String, NomReg As String)

   ...

End Sub

Puis regarde un peu ça :

Sub Saisie()

    Dim s As String

 
    Dim deps() As String

    Dim NomReg As String

 
    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

Voilà ce que j'ai pour le moment, mais ça ne marche pas...
ça bloque sur

Range(numligne & ":" & numligne).Select

               x = x + 1

               Selection.Copy Sheets("").Range("A" & x)

               n = n + 1

Sub test()

 
Dim numligne As Long

Dim depts As Integer

Dim n As Integer

Dim s As String

Dim deps() As String

Dim NomReg As String

 
' TRAITEMENT

' ----------

Application.ScreenUpdating = False

Sheets("Feuil1").Select

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

 
 
               Range(numligne & ":" & numligne).Select

               x = x + 1

               Selection.Copy Sheets("").Range("A" & x)

               n = n + 1

 
 
      numligne = numligne + 1

 
 
End Sub

Après correction, je bloque sur la lignes pour copier dans la nouvelle feuille.

Sub CopieParDepartement(deps() As String, NomReg As String)

 
End Sub

 
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

 
' TRAITEMENT

' ----------

Application.ScreenUpdating = False

Sheets("Feuil1").Select

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

 
               Range(s & ":" & s).Copy Sheets(deps).Range("A" & x)

 
                n = n + 1

 
                numligne = numligne + 1

 
 
End Sub

M'enfin, c'est la fonction CopieParDepartement qui doit copier tes lignes.

C'est bien ce qui me semblait, mais ça marche pas.
La nouvelle feuille ne se crée pas, pas de copie.

J'espère que

Sub CopieParDepartement(deps() As String, NomReg As String)

 
End Sub

n'est pas la totalité du code que tu utilises pour faire cette copie  

J'ai mis à la suite les deux codes (dans le même module).
J'ai bien les inputbox mais ça ne fait rien.
J'ai dû oublier quelque chose.

Mets un point d'arrêt dans une des macros (touche [F9])
Exécute normalement ta macro. Quand elle s'arrête, appuie sur [F8] pour dérouler ton programme pas-à-pas. Tu verras par où il passe ou ne passe pas.

Je crois que le défaut, c'est que je n'ai pas rempli la macro
Sub CopieParDepartement
Si il y avait quelque chose à y mettre.

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

M'enfin, là : http://www.presence-pc.com/forum/ppc/Programmation/copi...
je te donne tout ce dont tu as besoin.

Faut-il que je te fasse à ta place ?