VBA decomposer fichier en plusieurs avec criteres et sans liaison

Bonjour à tous,

Je viens demandé de l'aide pour un projet assez conséquent, je joins donc un fichier à ma demande avec les explications,

Je suis prêt à écouter toute proposition (modifications,idées ...) pour aboutir au projet,

Merci d'avance pour votre aide,

Cordialement,

Bonjour à tous,

Pour relancer mon sujet, il y a sur ce site ce code qui pourrait servir de base à ce que je demande (il est pas de moi bien sûr ):

Sub ExportDevisFacture()
    Dim wb As Workbook, nfeuil$, nclass$, chemin$, nm As Name
    chemin = "CheminDossierClassement\"
    nfeuil = "NomDevisFactureExporté"
    nclass = "NomClasseurCréé.xlsx"
    'Créer copie dans le classeur
    ActiveSheet.Copy before:=Worksheets(1)
    ActiveSheet.Name = nfeuil
    With Worksheets(nfeuil)
        .UsedRange.Copy
        .Range("A1").PasteSpecial xlPasteValues
    'Déplacement copie dans nouveau classeur
        .Move
    End With
    Set wb = ActiveWorkbook
    'Suppression des noms exportés dans le nouveau classeur
    For Each nm In wb.Names
        nm.Delete
    Next nm
    'Enregistrement
    wb.SaveAs chemin & nclass
End Sub

Je joins le lien du post sur lequel Mferrand avait répondu : https://forum.excel-pratique.com/excel/vba-decomposer-fichier-en-plusieurs-avec-criteres-et-sans-lia...

Merci d'avance pour votre aide,

Cordialement,

Bonjour à tous,

J'apporte une précision à mon post : je souhaiterai que le code me fasse un déplacer créer une copie des onglets concernés vers le fichier de destination, puis un collage valeur, une suppression des noms et si possible une rupture avec les connexions pour les TCD,

Cela devrait complexifier les choses, mais merci pour celui qui s’intéressera à mon projet,

Merci d'avance,

Cordialement,

Hello,

Peut être comme ceci :

Bonjour Rag02700,

Merci beaucoup pour votre retour, j'ai tenté de lancer la macro et vous trouverez ci-joint le message d'erreur lors de l’exécution de la macro me renvoi (cf fichier doc)

Alors effectivement le fichier n'existe pas car il faut le créer avec le nom de fichier préciser sur la colonne AK de l'onglet En tête, mais le chemin indiqué existe bien

La ligne surligné lors du débogage est la suivante :

ActiveWorkbook.SaveAs arr_val(2) & arr_val(1) & "_" & arr_val(0) & ".xlsx"

Merci d'avance pour votre aide et du temps consacré,

Cordialement,

Hello,

Oui il manque l'antislash (\) à la fin de tes chemins de dossier.

Soit tu l'ajoutes à tes chemins et tu gardes le fichier en l'état ou sinon modifier cette procédure comme ci dessous :

Sub creation_fichiers()

Dim lo As ListObject
Dim rng_temp As Range
Dim count1 As Long, count2 As Long
Dim arr_val(2)
Dim varr_temp As Variant

Set lo = ActiveSheet.ListObjects("IMPORT_ONGLET")

With lo
    .Range.AutoFilter Field:=3, Criteria1:=Range("AO2")
    count1 = .DataBodyRange.SpecialCells(xlCellTypeVisible).Rows.Count
    .Range.AutoFilter Field:=5, Criteria1:="OK"
    count2 = .DataBodyRange.SpecialCells(xlCellTypeVisible).Rows.Count
    If count1 = count2 Then
         For Each rng_temp In .DataBodyRange.SpecialCells(xlCellTypeVisible).Rows
            arr_val(0) = .DataBodyRange(rng_temp.Row, 1).Value
            arr_val(1) = .DataBodyRange(rng_temp.Row, 2).Value
            arr_val(2) = IIf(Right(.DataBodyRange(rng_temp.Row, 4).Value, 1) <> "\", _
                            .DataBodyRange(rng_temp.Row, 4).Value & "\", _
                            .DataBodyRange(rng_temp.Row, 4).Value)
            Sheets(arr_val(0)).Copy
            ActiveWorkbook.Sheets(1).Cells.Copy
            ActiveWorkbook.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False
            For Each varr_temp In ActiveWorkbook.Names
                 varr_temp.Delete
            Next
            ActiveWorkbook.SaveAs arr_val(2) & arr_val(1) & "_" & arr_val(0) & ".xlsx"
            SupprimerLiaisons (ActiveWorkbook)
            ActiveWorkbook.Close
        Next rng_temp
    End If
End With
Set lo = Nothing

End Sub

Merci pour ton retour Rag02700,

Mais même en ajoutant l'antislash sur mon chemin, ça bloque toujours au même endroit et même en remplaçant par le code fourni,

Mais je ne vois pas de différences dans les deux codes ?,

Merci pour ton aide,

Cordialement,

Hello,

nouvelle version :

Bonsoir Rag02700,

Merci pour votre retour,

Je suis désolé mais j'ai de nouveau testé le fichier joint et il me mets le même message d'erreur

ActiveWorkbook.SaveAs arr_val(2) & arr_val(1) & "_" & arr_val(0) & ".xlsx"

Pourriez vous créer sur votre poste le chemin (sauf pour P) afin de le tester ?,

Merci d'avance,

Cordialement,

Hello,

C'est étrange, chez moi ça fonctionne bien (avec le même chemin que vous, sauf à la place de P: c'est C: chez moi)

Vous avez accès en écriture-lecture sur ces répertoires ou seulement en lecture ?

Bonjour Rage02700

Ah non j'ai accès en lecture et en écriture c'est mon répertoire perso ...

Mais il bloque toujours au bout de code que je vous ai envoyé

Merci de ton aide mais effectivement si ça fonctionne chez toi

Mon chemin créer pour la classe 3 est bien P:\P-E\C G\B CR\Z\2020\CLASSE 3, donc je ne vois pas il n'y aucun fichier existant sur ce dossier, mais le code ne créer pas le fichier voulu ...

Cordialement,

Bonsoir Rag02700,

Je te renvoi une copie d'écran de l'erreur d'éxécution du code VBA, mais c'est etrange car il veut enregistré apparement comme ceci :

P:\P-E\C G\B CR\Z\2020\CLASSE 3\AA570530 mais effectivement ce fichier n'existe pas ?, et Pourquoi ce chiffre?,

car le fichier créer pour l'onglet G devrait s'appelait :

Merci d'avance pour votre aide,

Cordialement,

Etrange ...

Tu utilises exactement le même fichier que tu m'as envoyé ?

T'as essayé sur un autre répertoire ?

Oui j'utilise le même fichier que tu m'as envoyé et même sous un autre répertoire cela ne marche pas ...

Désolé de ne pas trouver le problème

Mais a dans le message d'erreur il veut accéder au fichier AA570530 mais celui ci n'existe pas , c'est peut pour cela qu'il ne le trouve pas, ce que je ne comprends pas c'est que je souhaite de créer un fichier qui n'existe pas, alors pourquoi ce message?,

Cordialement,

En fait il ne l'enregistre pas car il manque l'extension du fichier (.xlsx)

mais en revanche je ne vois pas d'où viens cette chaine de caractère ...

Par contre pour l'enregistrement je prends 3 valeurs :

1) le chemin

2) le nom

3) le nom de la feuille

ActiveWorkbook.SaveAs arr_val(2) & arr_val(1) & "_" & arr_val(0) & ".xlsx"

et après je rajoute l'extension (.xlsx)

En fait c'est comme si il ne prenait pas en compte le nom qu'il y a dans la colonne (nom fichier) ni le nom de la feuille

J'avoue sécher... et chez moi pas de soucis ...

Merci beaucoup Rag02700 pour ton implication,

Effectivement je ne vois pas non plus ce qu'il ne va pas, ayant très limité sur VBA,

Si d'autres membres du forum a une idée du problème je suis preneur

Cordialement,

Bonjour à tous,

Quelqu'un pourrait il essayer de me trouver une solution?,

Merci d'avance,

Cordialement,