bonjour à tous
je cherche une macro qui puisse me créer la liste suivante :
je possède sur un fichier feuille 1 un liste de nom de ville en A2:A350
Cette liste de villes est trié alphabétiquement.
En C2:C350 une liste de noms de responsableservice gérants ces villes, ces
noms sont actuellement au nombre de 4 mais à terme ce nombre risque
d'augmenter.
Ces noms de responsable de service sont aléatoires et sont inscrits en F1 F2
F3 F4
je désirerais que sur la feuille 2 en A1 soit inscrit le nom du 1er gérant
de service en B1 le nom du 2ème service
en C1 le nom du 3éme service et en D1 le nom du 4éme service (ces noms se
trouvent en F1:F4 sur la feuille 1)
et en dessous de chaque service apparaisse la liste des villes qui sont
gérés par ces gérants d'après la liste se trouvant sur la feuille 1
J'espère avoir était clair.
Avec mes remerciements.
--
Ctitout B-{}
°¨¨¨¨°ºo§oº°¨¨¨¨°ºo§oº°¨¨¨¨°ºo§oº°¨¨¨¨°ºo§oº°¨¨¨¨°ºo§oº°¨¨¨¨°
il ne faut pas mettre du vinaigre dans ses écrits,
il faut y mettre du sel. (Montesquieu)
°¨¨¨¨°ºo§oº°¨¨¨¨°ºo§oº°¨¨¨¨°ºo§oº°¨¨¨¨°ºo§oº°¨¨¨¨°ºo§oº°¨¨¨¨°
Et si tu veux un ajustement automatique de TOUTES les colonnes à la plus grande largeur : Sub trie()
fdest = "Feuil2" Set org = Sheets("Feuil1") Set dest = Sheets(fdest).[A1]
For i = 1 To org.[F65536].End(xlUp).Row dest.Offset(0, i - 1) = org.Range("F" & i) ligne = 1 For l = 1 To org.[A65536].End(xlUp).Row If org.Range("C" & l) = dest.Offset(0, i - 1) Then dest.Offset(ligne, i - 1) = org.Range("A" & l) ligne = ligne + 1 End If Next l With Sheets(fdest).Columns(i) .AutoFit If largeur < .ColumnWidth Then largeur = .ColumnWidth Sheets(fdest).Range([A1], Cells(1, i)).ColumnWidth > largeur End If End With Next i End Sub
Ctitout wrote si je supprime les lignes aprés next I et avant End Sub le transfert est bien exécuté mais les colonnes sont "trop étroites" par contre si je passe la macro en entière elle bloque après avoir rempli que la colone A en partie et en mélangeant les groupes "Erreur d'exécution 1004 - Erreur définie par l'application ou par l'objet"
Bonjour malgré de multiples essais cela bloque toujours j'ai donc changé par : Sheets("Feuil2").Columns(i).ColumnWidth = 26 encore merci la programme fonctionne bon dimanche
--
Ctitout B-{}
°¨¨¨¨°ºo§oº°¨¨¨¨°ºo§oº°¨¨¨¨°ºo§oº°¨¨¨¨°ºo§oº°¨¨¨¨°ºo§oº°¨¨¨¨° il ne faut pas mettre du vinaigre dans ses écrits, il faut y mettre du sel. (Montesquieu) °¨¨¨¨°ºo§oº°¨¨¨¨°ºo§oº°¨¨¨¨°ºo§oº°¨¨¨¨°ºo§oº°¨¨¨¨°ºo§oº°¨¨¨¨°
Rai wrote:
Et si tu veux un ajustement automatique de TOUTES les colonnes à la
plus grande largeur :
Sub trie()
fdest = "Feuil2"
Set org = Sheets("Feuil1")
Set dest = Sheets(fdest).[A1]
For i = 1 To org.[F65536].End(xlUp).Row
dest.Offset(0, i - 1) = org.Range("F" & i)
ligne = 1
For l = 1 To org.[A65536].End(xlUp).Row
If org.Range("C" & l) = dest.Offset(0, i - 1) Then
dest.Offset(ligne, i - 1) = org.Range("A" & l)
ligne = ligne + 1
End If
Next l
With Sheets(fdest).Columns(i)
.AutoFit
If largeur < .ColumnWidth Then
largeur = .ColumnWidth
Sheets(fdest).Range([A1], Cells(1, i)).ColumnWidth > largeur End If
End With
Next i
End Sub
Ctitout wrote
si je supprime les lignes aprés next I
et avant End Sub
le transfert est bien exécuté mais les colonnes sont "trop étroites"
par contre si je passe la macro en entière elle bloque après avoir
rempli que la colone A en partie et en mélangeant les groupes
"Erreur d'exécution 1004 - Erreur définie par l'application ou par
l'objet"
Bonjour
malgré de multiples essais cela bloque toujours j'ai donc
changé par :
Sheets("Feuil2").Columns(i).ColumnWidth = 26
encore merci
la programme fonctionne
bon dimanche
--
Ctitout B-{}
°¨¨¨¨°ºo§oº°¨¨¨¨°ºo§oº°¨¨¨¨°ºo§oº°¨¨¨¨°ºo§oº°¨¨¨¨°ºo§oº°¨¨¨¨°
il ne faut pas mettre du vinaigre dans ses écrits,
il faut y mettre du sel. (Montesquieu)
°¨¨¨¨°ºo§oº°¨¨¨¨°ºo§oº°¨¨¨¨°ºo§oº°¨¨¨¨°ºo§oº°¨¨¨¨°ºo§oº°¨¨¨¨°
Et si tu veux un ajustement automatique de TOUTES les colonnes à la plus grande largeur : Sub trie()
fdest = "Feuil2" Set org = Sheets("Feuil1") Set dest = Sheets(fdest).[A1]
For i = 1 To org.[F65536].End(xlUp).Row dest.Offset(0, i - 1) = org.Range("F" & i) ligne = 1 For l = 1 To org.[A65536].End(xlUp).Row If org.Range("C" & l) = dest.Offset(0, i - 1) Then dest.Offset(ligne, i - 1) = org.Range("A" & l) ligne = ligne + 1 End If Next l With Sheets(fdest).Columns(i) .AutoFit If largeur < .ColumnWidth Then largeur = .ColumnWidth Sheets(fdest).Range([A1], Cells(1, i)).ColumnWidth > largeur End If End With Next i End Sub
Ctitout wrote si je supprime les lignes aprés next I et avant End Sub le transfert est bien exécuté mais les colonnes sont "trop étroites" par contre si je passe la macro en entière elle bloque après avoir rempli que la colone A en partie et en mélangeant les groupes "Erreur d'exécution 1004 - Erreur définie par l'application ou par l'objet"
Bonjour malgré de multiples essais cela bloque toujours j'ai donc changé par : Sheets("Feuil2").Columns(i).ColumnWidth = 26 encore merci la programme fonctionne bon dimanche
--
Ctitout B-{}
°¨¨¨¨°ºo§oº°¨¨¨¨°ºo§oº°¨¨¨¨°ºo§oº°¨¨¨¨°ºo§oº°¨¨¨¨°ºo§oº°¨¨¨¨° il ne faut pas mettre du vinaigre dans ses écrits, il faut y mettre du sel. (Montesquieu) °¨¨¨¨°ºo§oº°¨¨¨¨°ºo§oº°¨¨¨¨°ºo§oº°¨¨¨¨°ºo§oº°¨¨¨¨°ºo§oº°¨¨¨¨°
