VBA scinder un fichier en plusieurs

[surgeon84fr]

Bonjour aux experts de cet excellent forum

J'ai besoin de vos compétences en macros VBA tant les miennes sont limitées.

Je dispose d'un assez gros fichier (28 colonnes sur 4000 lignes).
La première ligne contient les entêtes de chaque colonne.
Une des colonnes est dénommée "GRAND COMPTE".

Attention, le fichier de départ contient une macro à l'ouverture et à la fermeture qui protège les feuilles.

Mon besoin:

Je souhaiterais que la feuille soit triée selon les informations de cette colonne puis que soient créés autant de fichiers qu'il y a de données différentes dans la colonne "GRAND COMPTE".
Il faudrait que chaque fichier enregistré le soit dans un répertoire du même nom. Si le répertoire n'existe pas, la macro le crée.
Il faudrait que la macro teste l'existence du fichier dans le répertoire avant la sauvegarde et écrase l'existant.
Il faudrait aussi que le formatage du nom du nouveau fichier ressemble à ça:

"AAAAMMJJ_info de la colonne "GRAND COMPTE".xlsm
où AAAA est l'année, MM le mois et JJ le jour de la création.

Je vous ai mis en PJ le fichier TEST et les fichiers pour les résultats souhaités.

Je vous remercie par avance pour votre aide

 

[surgeon84fr]

Re : VBA scinder un fichier en plusieurs

Bonjour à tous
Sans réponse je me demandais s'il vous manquait des infos pour y arriver?
J'ai essayé d'être le plus clair possible dans ma demande.

En espérant que vous pourrez m'aider.

Cdlt

 

[surgeon84fr]

Re : VBA scinder un fichier en plusieurs

Bonsoir.

sans aide, j'ai cherché sur ce forum et ailleurs et voici ce que j'ai fait:
Je ne sais pas si c'est optimisé, mais ça fait ce que je voulais.

Bonne soirée à tous.

Cdlt

Option Explicit

Sub scinder()

Dim Nwbk As Workbook
Dim chemin1, chemin2, chemin3 As String, colGdCpte As String
Dim Nmbk As String
Dim i As Long, firstline As Long, lastline As Long

chemin1 = ThisWorkbook.Path

colGdCpte = "F"

With ThisWorkbook.Sheets("RCD")
    .Unprotect
    .Range(.Range("A1"), .Range("A1").End(xlToRight).End(xlDown)).Sort key1:=.Range(colGdCpte & "2"), order1:=xlAscending, Header:=xlYes

    For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
        firstline = i
        
        While .Range(colGdCpte & i).Text = .Range(colGdCpte & i + 1).Text
            i = i + 1
        Wend
        
        Nmbk = .Range(colGdCpte & i).Value
        
        lastline = i
        
        Set Nwbk = Application.Workbooks.Add(xlWBATWorksheet)
        .Rows(1).Copy Nwbk.Sheets(1).Range("A1")
        .Rows(firstline & ":" & lastline).Copy Nwbk.Sheets(1).Range("A2")
                 
        If Dir(chemin1 & "\RCD PAR GRAND COMPTE", vbDirectory) <> "RCD PAR GRAND COMPTE" Then
        MkDir (chemin1 & "\RCD PAR GRAND COMPTE")
        End If
        chemin2 = chemin1 & "\RCD PAR GRAND COMPTE\"
        If Dir(chemin2 & Nmbk, vbDirectory) <> Nmbk Then
        MkDir (chemin2 & Nmbk)
        End If
        chemin3 = chemin2 & Nmbk
        On Error Resume Next
        Kill chemin3 & "\" & Format(Now, "yyyy" & "mm" & "dd") & "_" & Nmbk & ".xlsx"
        On Error GoTo 0
                            
        Nwbk.SaveAs chemin3 & "\" & Format(Now, "yyyy" & "mm" & "dd") & "_" & Nmbk & ".xlsx"
        
        Nwbk.Close True
    
    Next i

End With

End Sub

 

[surgeon84fr]

Re : VBA scinder un fichier en plusieurs

Bonjour le Forum.

J'espère avoir plus de succès avec ma nouvelle demande qui se rapporte à la macro précédemment citée.

Sans changer les fichiers exemples joints, pour d'autres cas, je vais avoir besoin que plusieurs "GRANDS COMPTE" différents soient cependant réunis dans un même fichier.

J'ai créé les 2 lignes suivantes: (pour rester sur les cas de mes exemples en sachant qu'il y en a beaucoup d'autres)

dim Tb as variant
tb=array("BCAC",CFIAR","CAA")

Je ne sais pas comment intégrer dans la macro précédente le test sur le nom du grand compte et vérifier qu'il appartient au l'ensemble prédéfini avant de créer le fichier de sauvegarde.

En espérant que quelqu'un trouve du temps pour m'aider. Je suis bel et bien coincé cette fois...

Cordialement

 

[Marc L]

Bonjour ! P'tite démonstration …

Sub Demo()
    Dim Tb As Variant, M As String, S As String, V
        Tb = Array("BCAC", "CFIAR", "CAA")
    Do
            S = InputBox(M & vbLf & vbLf & "Code ?", "Test de vérification")
         If S = "" Then Exit Sub
            V = Application.Match(S, Tb, 0)
            M = S & IIf(IsError(V), " non trouvé …", " OK !")
' ou encore :
'           M = S & IIf(IsNumeric(V), " OK !", " non trouvé …")
    Loop
End Sub

_______________________________________________________________________________
Merci de cliquer sur J'aime ce post en bas à gauche de chaque message ayant aidé …

_______________________________________________________________________________
Je suis Paris, Charlie, …
​

 

[surgeon84fr]

Re : VBA scinder un fichier en plusieurs

Bonjour et merci Marc L

Je ne comprends pas ta macro.Comment ces lignes s'insèrent dans la mienne?
A moins que ce soit nécessaire, je n'ai pas besoin d'une nouvelle macro.

En fait lorsque ma macro s’exécute, elle parcourt la colonne F(GRANDS COMPTE) qui est triée par ordre alphabétique.
Donc, jusqu'à que le terme de la colonne F change, la macro tourne et dès que le terme change, elle copie et colle dans un nouveau fichier qui est renommé, sauvegardé et fermé.

"BCAC", "CFIAR" et "CAA" sont parmi plusieurs autres, admettons qu'on les appelle "A1", "A2","C1","D1".
Je crée donc 2 lignes comme précédemment:

dim Tb as variant
tb=array("BCAC",CFIAR","CAA")

Mon besoin (en espérant bien m'exprimer) est que la colonne F, étant classée par ordre alphabétique, va ressembler à ça:

"A1", "A2","BCAC","C1",CFIAR","CAA","D1".

Lorsque ma macro tourne et qu'elle suit l'ordre des termes, ceux qui doivent être réunis dans un même fichier ne se suivent pas :

array("BCAC",CFIAR","CAA")

C'est là que je coince et que je ne comprends pas ta macro supplémentaire.

Merci encore pour ton aide.

 

[surgeon84fr]

Re : VBA scinder un fichier en plusieurs

Bonjour

je vois que ma demande fais fureur. Je ne comprends pas pourquoi.

Je vais me débrouiller.

J'ai trouvé une astuce qui n'est pas du tout orthodoxe mais qui fera mon affaire.

Bonne continuation.