Renvoi données sur plusieurs onglets selon critères

[Spidtrip]

Bonjour à tous,

Je ne peux décidement plus me passer de vous....
Cette fois, j'ai un fichier avec plusieurs régions. Chacune de ces régions regroupent plusieurs départements. J'ai également une liste d'adresse.
Mon objectif est de renvoyer dans un onglet spécifique à sa région (1 par région - à créer automatiquement si impacté) chacune des lignes de l'onglet "Sites".
Comment lancer cela automatiquement d'après vous ?

Je vous joint un fichier d'exemple. Le fichier original ne comportera que les onglets "Liste Depts - Regions" et "Sites", le reste devant être généré automatiquement.

Merci pour votre aide
bye

 

[pierrejean]

Re : Renvoi données sur plusieurs onglets selon critères

bonjour Spidtrip

vois si cela te convient

 

[Spidtrip]

Re : Renvoi données sur plusieurs onglets selon critères

Bonjour PierreJean,

Super ta macro, mais je l'ai mis en application de suite, mais j'ai apparemment un pbl sur Paris.
En fait, lorsque je lance la macro après avoir rajouté l'ensemble de mes adresses, dont une adresse à Paris, cette dernière est créée dans un onglet "GUADELOUPE", oups.
Peux-tu me dire comment modifier la macro en conséquence stp.
En tout cas merci, super rapide et tout et tout
bye

 

[pierrejean]

Re : Renvoi données sur plusieurs onglets selon critères

bonsoir SpidTrip

en effet il y avait bien une erreur

voila qui te donnera Paris

Option Explicit
Sub test()
Dim c As Range
Dim dep As Integer
Dim n As Integer
Dim x As Integer
Dim flag As Boolean
Application.ScreenUpdating = False
For n = 1 To Sheets.Count
 If Sheets(n).Name <> "Sites" And Sheets(n).Name <> "Liste Depts - Regions" Then
   Sheets(n).Range("A2:C" & Sheets(n).Range("A65536").End(xlUp).Row + 1).ClearContents
 End If
Next n
For n = 2 To Sheets("Sites").Range("B65536").End(xlUp).Row
 dep = Val(Sheets("Sites").Range("B" & n)) / 1000
With Worksheets("Liste Depts - Regions").Range("A2:A" & Worksheets("Liste Depts - Regions").Range("A65536").End(xlUp).Row)
    Set c = .Find(dep, LookAt:=xlWhole)
    If Not c Is Nothing Then
       For x = 1 To Sheets.Count
         If Sheets(x).Name = .Range("C" & c.Row) Then
           
           Sheets("Sites").Range("A" & n & ":C" & n).Copy Destination:=Sheets(x).Range("A65536").End(xlUp).Offset(1, 0)
           flag = True
         End If
       Next x
       If flag = False Then
          [COLOR=red]Worksheets.Add.Name = Worksheets("Liste Depts - Regions").Range("C" & c.Row)
[/COLOR]          Sheets("Sites").Range("A1:C1").Copy Destination:=ActiveSheet.Range("A1")
          Sheets("Sites").Range("A" & n & ":C" & n).Copy Destination:=ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0)
       End If
       flag = False
    End If
End With
Next n
Sheets("Sites").Select
Application.ScreenUpdating = True
End Sub

[\code]

 

[Spidtrip]

Re : Renvoi données sur plusieurs onglets selon critères

Merci PierreJean,

Je n'ai pas beaucoup de connaissance en macro, peux-tu me dire où consulter la macro et comment la modifier stp.
Bonne soirée
bye

 

[Spidtrip]

Re : Renvoi données sur plusieurs onglets selon critères

Bonjour à tous,

Voilà, j'utilise la macro que PierreJean m'a gentillement créé, mais je me retrouve avec debogage au niveau de : -> Worksheets.Add.Name = Worksheets("Liste Depts - Regions").Range("C" & c.Row)

Option Explicit
Sub test()
Dim c As Range
Dim dep As Integer
Dim n As Integer
Dim x As Integer
Dim flag As Boolean
Application.ScreenUpdating = False
For n = 1 To Sheets.Count
If Sheets(n).Name <> "Sites" And Sheets(n).Name <> "Liste Depts - Regions" Then
Sheets(n).Range("A2:C" & Sheets(n).Range("A65536").End(xlUp).Row + 1).ClearContents
End If
Next n
For n = 2 To Sheets("Sites").Range("B65536").End(xlUp).Row
dep = Val(Sheets("Sites").Range("B" & n)) / 1000

With Worksheets("Liste Depts - Regions").Range("A2:A" & Worksheets("Liste Depts - Regions").Range("A65536").End(xlUp).Row)
Set c = .Find(dep, LookAt:=xlWhole)
If Not c Is Nothing Then

For x = 1 To Sheets.Count
If Sheets(x).Name = .Range("C" & c.Row) Then

Sheets("Sites").Range("A" & n & ":C" & n).Copy Destination:=Sheets(x).Range("A65536").End(xlUp).Offset(1, 0)
flag = True
End If
Next x
If flag = False Then
Worksheets.Add.Name = Worksheets("Liste Depts - Regions").Range("C" & c.Row)
Sheets("Sites").Range("A1:C1").Copy Destination:=ActiveSheet.Range("A1")
Sheets("Sites").Range("A" & n & ":C" & n).Copy Destination:=ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0)
End If
flag = False
End If
End With
Next n
Sheets("Sites").Select
Application.ScreenUpdating = True
End Sub


Je vous joint le fichier de test
Merci pour votre aide
bye

 

[Spidtrip]

Re : Renvoi données sur plusieurs onglets selon critères

Re tout le monde,

J'ai une précision complémentaire, voici ce qui est affiché dans la fenêtre après avoir lancé la macro :

"erreur d'exécution 1004"

Impossible de renommer une feuille comme une autre feuille, une bibliothèque d'objets référencée ou un classeur référencé par visual basic.

Est-ce que cela vous parle mieux ?

Merci d'avance pour vos réponses.
bye

 

[pierrejean]

Re : Renvoi données sur plusieurs onglets selon critères

bonjour SpidTrip

Toutes mes excuses

je me suis fait pieger par un With

Voila ton fichier réparé pour l'instant

J'en profite pour te signaler que la recherche est basée sur les 2 premiers chiffres du code postal et que cela ne correspond pas en ce qui concerne la corse la guadeloupe ,réunion etc
Si tu dois avoir des sites la_bas donne moi des exemples afin que je traite ces cas particuliers
a titre indicatif c'est Excel_lent qui m'a mis la puce a l'oreille concernant ces cas particuliers

 

[Spidtrip]

Re : Renvoi données sur plusieurs onglets selon critères

Une nouvelle fois, merci PierreJean.
Tu es complètement excusé, tu me donnes tout de même à bon coup de main.
Sinon, je risque effectivement d'avoir des cas pour la Corse.
Je relancerai la discussion le moment venu pour te demander ton avis.
Encore merci et bon week-end
bye

 

[Spidtrip]

Re : Renvoi données sur plusieurs onglets selon critères

Au secours PierreJean,

J'ai le même bogage que tout à l'heure, peux-tu me confirmer que tout fonctionne chez toi ?

Merci
bye

 

[pierrejean]

Re : Renvoi données sur plusieurs onglets selon critères

re

on n'a vraiment pas de chance !!!!

cette fois je me suis melangé les pinceaux dans mes repertoires

vois si cela va mieux

 

[Spidtrip]

Re : Renvoi données sur plusieurs onglets selon critères

Génial PierreJean,
Cà fonctionne à merveille maintenant
Merci bcp
@+

 

[Spidtrip]

Re : Renvoi données sur plusieurs onglets selon critères

Bonjour PierreJean, Le forum


Je repasse parmi vous car je viens de m'apercevoir que le fichier m'indique le département du 35 dans la Centre Val de Loire alors qu'il fait partie de la région Bretagne.

Merci pour votre aide.
bye

 

[Spidtrip]

Re : Renvoi données sur plusieurs onglets selon critères

PierreJean,

Je t'envoi le fichier sur lequel apparaît l'erreur
Merci

 

[pierrejean]

Re : Renvoi données sur plusieurs onglets selon critères

bonsoir SpidTrip

piégé cette fois par 34,970 trop pres de 35 !!!!!

voila le corrigé

avec toutes mes excuses