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

12classeur1.xlsx (11.03 Ko)

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 Sub

C'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"

10classeur2.xlsx (12.05 Ko)

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 Sub

merci beaucoup

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" ?

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 Sub

C'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 Sub

Super, c'est parfait

Un très grand merci

Rechercher des sujets similaires à "extraction donnees"