Extraction de données
Bonjour,
Est-il possible à partir de l'onglet de l'exemple, d'extraire les données triées par "Secteur référent" et de les copier dans des fichiers excel séparés (fichiers qui vont se créer automatiquement j'imagine)
merci d'avance
Bonjour,
une solution via une macro
Sub aargh()
Set ws = Sheets("feuil1")
i = 2
While Not fin
If ws.Cells(i, 3) <> psr Then
If fr <> 0 Then
Set wb = Workbooks.Add
Set wso = wb.Sheets(1)
ws.Rows(1).Copy wso.Range("a1")
ws.Rows(fr & ":" & i - 1).Copy wso.Range("a2")
wb.SaveAs psr
wb.Close
End If
psr = ws.Cells(i, 3)
If psr = "" Then fin = True
fr = i
End If
i = i + 1
Wend
End SubC'est top ! c'est exactement ce que je voulais. Un très grand merci
Mais j'ai un soucis je ne comprends pas grand chose au code que tu as fourni pour pouvoir le modifier dans mon fichier de travail. (il faut absolument que je me forme)
Je me permets de renvoyer un autre fichier qui contient toutes les colonnes sur lesquelles je travaille.
La demande est la même : créer des fichiers en fonction des "Secteurs référents"
bonjour,
code adapté et commenté
Sub aargh()
Set ws = Sheets("feuil1") ' ws= indicatif feuille de base
i = 2 'i= pointeur de ligne sur ws
While Not fin 'tant que le traitement n'est pas fini
If ws.Cells(i, "AM") <> psr Then 'si le référent sur la ligne i est différent du referent en cours
If fr <> 0 Then 'si pas la première ligne
Set wb = Workbooks.Add 'on cree un classeur
Set wso = wb.Sheets(1) 'wso = indicatif feuille qui doit recevoir les données
ws.Rows(1).Copy wso.Range("a1") 'on copie l'entête
ws.Rows(fr & ":" & i - 1).Copy wso.Range("a2") 'on copie le groupe de ligne
wb.SaveAs psr 'on sauve le classeur en lui donnant le nom du référent
wb.Close 'on ferme le classeur
End If
psr = ws.Cells(i, "AM") ' on mémorise le nouveau référent en cours
If psr = "" Then fin = True 'si le nouveau référent en cours est blanc c'est fini
fr = i ' on mémorise la première ligne du groupe référent en cours
End If
i = i + 1 'on incrémente le pointeur de ligne
Wend 'on boucle
End SubIl y a un petit souci car le traitement (688 lignes) commence sans problème en me créant les fichiers mais il s'arrête avec une erreur "400" ?
tifan a écrit :Il y a un petit souci car le traitement (688 lignes) commence sans problème en me créant les fichiers mais il s'arrête avec une erreur "400" ?
quel reférent y a-t-il en ligne 688 et 689 ? probablement un nom qui contient des caractères non valables pour un nom de fichier.
effectivement il y avait une erreur dans les dernières cellules.
J'ai remarqué aussi qu'il fallait que les secteurs soient dans l'ordre alphabétique sinon cela demandait de créer plusieurs fichiers du même secteur
Merci pour tout
Petit question supplémentaire (j'espère ne pas trop abuser) :
est-il possible dans la macro d'ajouter lorsque le fichier "Secteur référent" se créé :
_ de garder la mise en forme des colonnes et le zoom
_ de nommer l'onglet "Feuil1" qui se renseigne automatiquement (avec "rentree 2016")
_ de nommer les deux autres onglets ("Feuil2" en "eleves manquants" / "Feuil3" en "previsions")
Petit question supplémentaire (j'espère ne pas trop abuser) :
est-il possible dans la macro d'ajouter lorsque le fichier "Secteur référent" se créé :
_ de garder la mise en forme des colonnes et le zoom
_ de nommer l'onglet "Feuil1" qui se renseigne automatiquement (avec "rentree 2016")
_ de nommer les deux autres onglets ("Feuil2" en "eleves manquants" / "Feuil3" en "previsions")
Bonjour,
code adapté
Sub aargh()
Set ws = Sheets("feuil2") ' ws= indicatif feuille de base
zo = ActiveWindow.Zoom
i = 2 'i= pointeur de ligne sur ws
While Not fin 'tant que le traitement n'est pas fini
If ws.Cells(i, "AM") <> psr Then 'si le référent sur la ligne i est différent du referent en cours
If fr <> 0 Then 'si pas la première ligne
Set wb = Workbooks.Add 'on cree un classeur
Set wso = wb.Sheets(1) 'wso = indicatif feuille qui doit recevoir les données
wso.Name = "rentrée 2016"
wb.Sheets(2).Name = "élèves manquants"
wb.Sheets(3).Name = "prévision"
ActiveWindow.Zoom = zo
ws.Rows(1).Copy wso.Range("a1") 'on copie l'entête
ws.Rows(fr & ":" & i - 1).Copy wso.Range("a2") 'on copie le groupe de ligne
wb.SaveAs psr 'on sauve le classeur en lui donnant le nom du référent
wb.Close 'on ferme le classeur
End If
psr = ws.Cells(i, "AM") ' on mémorise le nouveau référent en cours
If psr = "" Then fin = True 'si le nouveau référent en cours est blanc c'est fini
fr = i ' on mémorise la première ligne du groupe référent en cours
End If
i = i + 1 'on incrémente le pointeur de ligne
Wend 'on boucle
End SubC'est top.
Deux petites questions :
_ à quel endroit du code je sais où s'enregistrent les fichiers ?
_ est-il possible de modifier ce code pour que la première ligne de l'onglet 1 (celle de l'intitulé des colonnes) soit aussi sur les onglets 2 et 3 ?
Vraiment merci beaucoup
Bonjour,
les fichiers s'enregistrent dans le même répertoire que le fichier contenant la macro.
voici les modifications.
Sub aargh()
Set ws = Sheets("feuil2") ' ws= indicatif feuille de base
zo = ActiveWindow.Zoom
i = 2 'i= pointeur de ligne sur ws
While Not fin 'tant que le traitement n'est pas fini
If ws.Cells(i, "AM") <> psr Then 'si le référent sur la ligne i est différent du referent en cours
If fr <> 0 Then 'si pas la première ligne
Set wb = Workbooks.Add 'on cree un classeur
Set wso = wb.Sheets(1) 'wso = indicatif feuille qui doit recevoir les données
wso.Name = "rentrée 2016"
wb.Sheets(2).Name = "élèves manquants"
wb.Sheets(3).Name = "prévision"
ActiveWindow.Zoom = zo 'on adapte le zoom pour la feuille 1
For j = 1 To 3 'on copie l'entête sur les 3 feuilles
ws.Rows(1).Copy Sheets(j).Range("a1") 'on copie l'entête
Next j
ws.Rows(fr & ":" & i - 1).Copy wso.Range("a2") 'on copie le groupe de ligne
wb.SaveAs psr 'on sauve le classeur en lui donnant le nom du référent
wb.Close 'on ferme le classeur
End If
psr = ws.Cells(i, "AM") ' on mémorise le nouveau référent en cours
If psr = "" Then fin = True 'si le nouveau référent en cours est blanc c'est fini
fr = i ' on mémorise la première ligne du groupe référent en cours
End If
i = i + 1 'on incrémente le pointeur de ligne
Wend 'on boucle
End SubSuper, c'est parfait
Un très grand merci