Extraction de données

Y compris Power BI, Power Query et toute autre question en lien avec Excel
t
tifan
Jeune membre
Jeune membre
Messages : 35
Inscrit le : 11 septembre 2014
Version d'Excel : 2007

Message par tifan » 25 mars 2016, 11:50

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
Classeur1.xlsx
(11.03 Kio) Téléchargé 11 fois
h
h2so4
Passionné d'Excel
Passionné d'Excel
Messages : 9'459
Appréciations reçues : 428
Inscrit le : 16 juin 2013
Version d'Excel : 365 UK Windows 10

Message par h2so4 » 25 mars 2016, 12:18

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
t
tifan
Jeune membre
Jeune membre
Messages : 35
Inscrit le : 11 septembre 2014
Version d'Excel : 2007

Message par tifan » 25 mars 2016, 12:29

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"
Classeur2.xlsx
(12.05 Kio) Téléchargé 9 fois
h
h2so4
Passionné d'Excel
Passionné d'Excel
Messages : 9'459
Appréciations reçues : 428
Inscrit le : 16 juin 2013
Version d'Excel : 365 UK Windows 10

Message par h2so4 » 25 mars 2016, 12:40

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
t
tifan
Jeune membre
Jeune membre
Messages : 35
Inscrit le : 11 septembre 2014
Version d'Excel : 2007

Message par tifan » 25 mars 2016, 13:27

merci beaucoup
t
tifan
Jeune membre
Jeune membre
Messages : 35
Inscrit le : 11 septembre 2014
Version d'Excel : 2007

Message par tifan » 25 mars 2016, 14:00

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" ?
h
h2so4
Passionné d'Excel
Passionné d'Excel
Messages : 9'459
Appréciations reçues : 428
Inscrit le : 16 juin 2013
Version d'Excel : 365 UK Windows 10

Message par h2so4 » 25 mars 2016, 14:09

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.
t
tifan
Jeune membre
Jeune membre
Messages : 35
Inscrit le : 11 septembre 2014
Version d'Excel : 2007

Message par tifan » 25 mars 2016, 16:00

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")
t
tifan
Jeune membre
Jeune membre
Messages : 35
Inscrit le : 11 septembre 2014
Version d'Excel : 2007

Message par tifan » 29 mars 2016, 08:47

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")
h
h2so4
Passionné d'Excel
Passionné d'Excel
Messages : 9'459
Appréciations reçues : 428
Inscrit le : 16 juin 2013
Version d'Excel : 365 UK Windows 10

Message par h2so4 » 29 mars 2016, 12:10

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
Répondre
  • Sujets similaires
    Réponses
    Vues
    Dernier message
  • Extraction de données
    par marco44 » 13 décembre 2018, 13:29 » dans Excel - VBA
    3 Réponses
    135 Vues
    Dernier message par dhany
    13 décembre 2018, 15:17
  • Extraction de données
    par Delgusto » 28 février 2019, 17:00 » dans Excel - VBA
    25 Réponses
    421 Vues
    Dernier message par Delgusto
    3 mars 2019, 15:57
  • extraction de données
    par domelopascamande » 24 août 2017, 11:37 » dans Excel - VBA
    5 Réponses
    293 Vues
    Dernier message par mbbp
    24 août 2017, 14:26
  • extraction de données
    par kholkhol » 23 juillet 2014, 19:44 » dans Excel - VBA
    1 Réponses
    134 Vues
    Dernier message par kholkhol
    23 juillet 2014, 20:49
  • extraction donnèes
    par merlinfafe » 9 octobre 2018, 21:32 » dans Excel - VBA
    5 Réponses
    172 Vues
    Dernier message par Steelson
    1 novembre 2018, 00:50
  • Extraction de Données
    par KTM » 18 mars 2020, 14:26 » dans Excel - VBA
    4 Réponses
    96 Vues
    Dernier message par KTM
    18 mars 2020, 22:24