Déplacements de contenus vers nouveaux onglets

Bonjour à tous,

Je cherche une aide pour écrire une macro.

Vous trouverez en pièce jointe deux fichiers : le fichier original, et le fichier avec le résultat souhaité.

Dans le fichier original vous trouverez l'en-tête sur la 1ère ligne, suivi des informations sur les lignes en dessous. Chaque ligne blanche représente un nouvel évènement (dans ce cas ci, il s'agit de concert pour la petite histoire).

Et j'aimerais qu'à l'aide d'une macro tout se mette comme dans le fichier "résultat final souhaité". Ce qui donne que chaque évènement, représenté par la ligne blanche, se retrouve dans un nouvel onglet, avec le même en-tête.

Pour info j'ai 12 fichiers par an à faire avec des milliers de lignes, un peu contraignant à faire cela manuellement.

Merci d'avance pour votre aide

Brut

Bonjour,

Teste le code suivant à insérer dans un module du classeur Source :

Sub dispatch()
    Dim shSource As Worksheet
    Set shSource = Sheets(1)
    Application.ScreenUpdating = False
    derLig = shSource.Range("A" & Rows.Count).End(xlUp).Row
    With shSource
        k = 2
        For i = 2 To derLig + 1
            If .Cells(i, "A") <> "" Then
                j = i
            Else
                .Rows("1:1").Copy
                Sheets.Add After:=ActiveSheet
                ActiveSheet.Name = .Cells(i - 1, "T")
                ActiveSheet.Rows("1:1").Insert Shift:=xlDown
                .Rows(k & ":" & j).Copy
                ActiveSheet.Rows("2:2").Insert Shift:=xlDown
                k = j + 2
            End If
        Next i
    End With
    Set shSource = Nothing
    Application.CutCopyMode = false
    Application.ScreenUpdating = True
End Sub

Bonjour Raja,

Merci d'avoir pris de ton temps pour me répondre.

J'ai testé, mais il bloque directement à la première ligne avec le message d'erreur 'compile error: variable not defined"

et surligne derLig =

Tu as une idée ?

Merci

Bonjour,

Voir PJ.

C'est fait avec ton fichier Original. Il faut adapter le code en fonction de ton fichier sur lequel tu testes.

Raja a écrit :

Bonjour,

Voir PJ.

C'est fait avec ton fichier Original. Il faut adapter le code en fonction de ton fichier sur lequel tu testes.

Quel talent !

Enorme Merci !

Bonne journée à toi

Brut

Bonjour le fil, bonjour le forum,

Encore grillé par Raja et ses codes Tip Top !... Je me permets quand même de te proposer mon code puisque je me suis embêter à le commenter... Code à placer sans le classeur original (qui deviendra, de fait, .xlsm.

Il va te créer un nouveau classeur (dans le même dossier que le fichier original) nommé : Concert Résultat jj_mm_aa.xlsx :

Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CH As String 'déclare la variable CH (CHemin d'accès)
Dim DL As Long 'déclare la variable DL (Dernière Ligne)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim NC As Byte 'déclare la variable NC (Nombre de colonnes)
Dim NB As Integer 'déclare la variable NB (NomBre de concert)
Dim NOP As Integer 'déclare la variable NOP (Nombre d'Onglets Préférence)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim DT As String 'déclare la variable DT (DaTe)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim L As Byte 'déclare la variable L (incrément)
Dim TMP As Variant 'déclare la variable TMP (Tableau TeMPoraire)
Dim O As Byte 'déclare la variable O (Onglet)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

Set CS = ThisWorkbook 'définit le classeur source CS
Set OS = CS.Worksheets("Original") 'définit l'onglet source OS
CH = CS.Path & "\" 'définit le chemin d'accès CH
DL = OS.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet source
TV = OS.Range("A1:U" & DL) 'définit la tableau des valeurs TV
NC = UBound(TV, 2) 'définit le nombre de colonnes NC du tableau des valeurs
NB = Application.WorksheetFunction.CountBlank(OS.Range("A1:A" & DL)) + 1 'définit le nombre de concerts NB (=Nombre de Blancs dans la colonne A des lignes 1 à DL + 1)
NOP = Application.SheetsInNewWorkbook 'définit le nombre d'onglet dans un nouveau classeur NOP (ta préférence actuelle)
Application.SheetsInNewWorkbook = NB 'définit le nombre d'onglets dans un nouveau classeur
Application.Workbooks.Add 'ajoute un classeur vierge
Application.SheetsInNewWorkbook = NOP 'rétablit ta préférence du nombre d'onglet dans un nouveau classeur
Set CD = ActiveWorkbook 'définit le classeur destination CD
DT = CStr(Format(Date, "dd_mm_yy")) 'définit la date DT au format texte
ActiveWorkbook.SaveAs CH & "Concert Résultat " & DT & ".xlsx", 51 'enregistre le classeur destination (même dossier que ton classeur source avec la date a la fin)
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To DL 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    If TV(I, 1) <> "" Then D(TV(I, 1)) = "" 'si la donnée ligne I colonne 1 de TV n'est pas vide, alimente le dictionnaire D avec cette donnée
Next I 'prochaine ligne de la boucle
TMP = D.Keys 'récupère dans le tableau temporaire TMP la liste des éléments du dictionnaire D sans doublon
O = 1 'initialise la variable O
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments du tableau temporaire TMP
    K = 1 'initialise la variable K
    For I = 2 To DL 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
        If TV(I, 1) = TMP(J) Then 'condition : si la donnée ligne I de TV est égale à l'élément J de TMP
            ReDim Preserve TL(1 To NC, 1 To K) 'redimensionne le tableau des lignes TL (autant de lignes que TV a de colonnes, K colonnes)
            For L = 1 To NC 'boucle 3 : sur toutes les colonnes L du tableau des valeurs TV
                TL(L, K) = TV(I, L) 'récupère dans la ligne L de TL la donnée en colonne L de TV (=> Transposition)
            Next L 'prochaine colonne de la boucle 3
            K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
    If K > 1 Then 'condition : si K est supérieure a 1
        CD.Sheets(O).Range("A1").Resize(1, NC).Value = Application.Index(TV, 1) 'renvoie les en-têtes du tableau source dans A1 redimensionnée de l'onglet O
        CD.Sheets(O).Range("A2").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL) 'renvoie le tableau TL transposé dans A2 redimensionnée de l'onglet O
    End If 'fin de la condition
    Erase TL 'vide le tableau TL
    O = O + 1 'incrémente la variable O
Next J 'prochaine élément de la boucle 1
End Sub

Hello !

Effectivement le code de Raja était extra.

Et Merci pour ton travail Tauthème

Seulement on m'a demandé si il était possible d'en faire des fichiers csv séparés au lieu d'onglets...Ca ferait encore moins de travail.

Est-ce que ce code peut facilement être modifié pour en faire des nouveaux fichiers csv ?

Merci d'avance !

Brut

Re,

Essaie comme ça alors... :

Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CH As String 'déclare la variable CH (CHemin d'accès)
Dim DL As Long 'déclare la variable DL (Dernière Ligne)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim NC As Byte 'déclare la variable NC (Nombre de colonnes)
Dim NB As Integer 'déclare la variable NB (NomBre de concert)
Dim NOP As Integer 'déclare la variable NOP (Nombre d'Onglets Préférence)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim DT As String 'déclare la variable DT (DaTe)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim L As Byte 'déclare la variable L (incrément)
Dim TMP As Variant 'déclare la variable TMP (Tableau TeMPoraire)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set CS = ThisWorkbook 'définit le classeur source CS
Set OS = CS.Worksheets("Original") 'définit l'onglet source OS
CH = CS.Path & "\" 'définit le chemin d'accès CH
DL = OS.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet source
TV = OS.Range("A1:U" & DL) 'définit la tableau des valeurs TV
NC = UBound(TV, 2) 'définit le nombre de colonnes NC du tableau des valeurs
NB = Application.WorksheetFunction.CountBlank(OS.Range("A1:A" & DL)) + 1 'définit le nombre de concerts NB (=Nombre de Blancs dans la colonne A des lignes 1 à DL + 1)
NOP = Application.SheetsInNewWorkbook 'récupere ta préférence NOP du nombre d'onglet dans un nouveau classeur
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
Application.SheetsInNewWorkbook = 1 'définit le nombre d'onglets dans un nouveau classeur (1 seul)
For I = 2 To DL 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    If TV(I, 1) <> "" Then D(TV(I, 1)) = "" 'si la donnée ligne I colonne 1 de TV n'est pas vide, alimente le dictionnaire D avec cette donnée
Next I 'prochaine ligne de la boucle
TMP = D.Keys 'récupère dans le tableau temporaire TMP la liste des éléments du dictionnaire D sans doublon
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments du tableau temporaire TMP
    K = 1 'initialise la variable K
    For I = 2 To DL 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
        If TV(I, 1) = TMP(J) Then 'condition : si la donnée ligne I de TV est égale à l'élément J de TMP
            ReDim Preserve TL(1 To NC, 1 To K) 'redimensionne le tableau des lignes TL (autant de lignes que TV a de colonnes, K colonnes)
            For L = 1 To NC 'boucle 3 : sur toutes les colonnes L du tableau des valeurs TV
                TL(L, K) = TV(I, L) 'récupère dans la ligne L de TL la donnée en colonne L de TV (=> Transposition)
            Next L 'prochaine colonne de la boucle 3
            K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
    If K > 1 Then 'condition : si K est supérieure a 1
        Application.Workbooks.Add 'ajoute un classeur vierge
        Set CD = ActiveWorkbook 'définit le classeur destination CD
        DT = CStr(Format(Date, "dd_mm_yy")) 'définit la date DT au format texte
        ActiveWorkbook.SaveAs CH & TL(20, 1) & DT & ".csv", 23 'enregistre le classeur destination (même dossier que ton classeur source avec la date a la fin)
        CD.Sheets(1).Range("A1").Resize(1, NC).Value = Application.Index(TV, 1) 'renvoie les en-têtes du tableau source dans A1 redimensionnée de l'onglet 1
        CD.Sheets(1).Range("A2").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL) 'renvoie le tableau TL transposé dans A2 redimensionnée de l'onglet 1
        CD.Close True 'enregistre et ferme le classeur destination
    End If 'fin de la condition
    Erase TL 'vide le tableau TL
Next J 'prochaine élément de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
Application.SheetsInNewWorkbook = NOP 'rétablit ta préférence du nombre d'onglets dans un nouveau classeur
End Sub

Bonjour Tauthème,

Je dois peut-être mal m'y prendre, mais j'ai des messages d'erreur à pratiquement chaque ligne du code.

Re,

Si tu ne m'en dis pas plus (ligne et message correspondant) je vois mal comment je pourrais t'aider !.... J'ai testé chez moi et ça fonctionne...

Je t'envoie ton fichier exemple avec le code dedans...

Bonjour ThauThème,

oui pardon, je n'ai pas été précis avec le problème.

J'ai donc réessayé avec le fichier que tu as mis en dernier. Cela fonctionne comme il faut, j'ai juste la version anglaise :-p Avec un simple text to columns c'est réglé.

Mais pour le reste c'est super, fichier avec le bon nom, la date etc...wow !

Merci beaucoup !

Bonne journée

Brut

Bonjour à tous,

Je me permets de réouvrir la demande, car j'ai eu des modifications à faire sur ce fichier. Et avec l'actuelle macro que Raja m'a gentiment faite, celle-ci ne fonctionne plus comme il faudrait.

Est-ce que quelqu'un, peut-être même Raja lui-même , pourrait éventuellement modifier la macro déjà existante ou alors en faire une autre ?

Pour rappel :

Dans le fichier Belgium Jan2.xlsx vous trouverez l'en-tête sur la 1ère ligne, suivi des informations sur les lignes en dessous. Chaque ligne blanche représente un nouvel évènement (dans ce cas ci, il s'agit de concert pour la petite histoire).

(...)

Ce qui donne que chaque évènement, représenté par la ligne blanche, se retrouve dans un nouvel onglet, avec le même en-tête.

Pour info j'ai 12 fichiers par an à faire avec des milliers de lignes, un peu contraignant à faire cela manuellement.

Merci d'avance en tout cas !

Brut

une petite aide svp...

Merci

Bonjour,

Essaye le programme en PJ.

Merci Raja !

très bon boulot, comme d'hab.

J'espère qu'on me demandera pas encore de la modifier....

Bonne journée !

Brut