Bouton de remplissage de tableau sur un autre fichier

Le 07/05/2025 à 08:56

Bonjour à tous

Je sollicite votre aide pour trouver une solution à mon problème. J'ai un fichier " Impr.Avancement CTP" qui comporte une extraction de notre base de donnée. Chaque semaine j'imprime ce tableau par "CTP" selon la sélection de liste déroulante que j'ai créé. Certaine personne aimerais l'avoir en version papier et d'autre en version excel.Je veux rajouter un bouton "Export Excel" en dessous de "Imprimer" qui copie le contenu du tableau entier "section => remarques" vers un autre fichier "Avancement Excel".

le contenu du tableau varie selon la selection de la liste déroulante déjà existante donc il n'a pas de taille fixe

A chaque fois que je vais appuier sur le bouton "Export Excel" le tableau devrais se vider avant de pouvoir afficher le nouveau résultat

Je vous joint le dossier qui comporte les deux fichier

Encore merci pour votre aide

41impr-avancement-ctp.xlsm (88.87 Ko)

26avancement-excel.xlsx (11.20 Ko)

Le 08/05/2025 à 11:47

Bonjouir,

Dans le fichier joint, sélectionnez vos critères en A1 et A2 puis cliquez sur le bouton "Préparation pour export excel" , cette action remplit la feuille et l'enregistre en tant que classeur en fonction des critères sélectionnés puis, vous devrez choisir l'emplacement et le nom que vous donnerez à ce classeur.

17ksiksi1-bouton-de-remplissage-de-tableau-sur-un-autre-fichier.xlsm (138.45 Ko)

le code dans le module 1:

Sub Export_Excel()
    Dim f1 As Worksheet, f3 As Worksheet
    Dim DerLig_f1 As Long, DerLig_f3 As Long, NbLig As Long, i As Long
    Dim Crit21 As String, Crit2 As String, Nom_Classeur As String
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set f1 = Sheets("BASE")
    Set f3 = Sheets("Sheet1")
    f3.Range("B3:O" & 10000).Clear
    DerLig_f1 = f1.Range("A" & Rows.Count).End(xlUp).Row
    f1.Range("A1:N" & DerLig_f1).Copy f3.Range("B3")

    'ne conserver que les CTP demandés
    DerLig_f3 = DerLig_f1 + 3
    Crit1 = f3.Range("A1").Value
    Crit2 = f3.Range("A2").Value
    For i = DerLig_f3 To 4 Step -1
        If f3.Cells(i, "C") <> "" And f3.Cells(i, "D") <> Crit1 And f3.Cells(i, "D") <> Crit2 Then f3.Rows(i).Delete
    Next i
    'Suppression  des colonnes "F2D, F2E,F3I"
    f3.Columns("K:M").Delete
    'Préparation^pour l'Export
    ActiveSheet.Copy
    Nom_Classeur = Application.GetSaveAsFilename 'sélectionnez le chemin et le nom à donner à cet enregistrement
    If Nom_Classeur <> Faux Then
        ActiveWorkbook.SaveAs Filename:=Nom_Classeur & ".xlsx" 'la feuille est enregistrée en tant que classeur prête à être expédiée
        ActiveSheet.Shapes.Range(Array("Picture 1")).Delete
        ActiveSheet.Shapes.Range(Array("ZoneTexte 1")).Delete
        Columns("A:A").Delete Shift:=xlToLeft
    End If
    Set f1 = Nothing
    Set f3 = Nothing
End Sub

Cdlt

Le 08/05/2025 à 14:10

Merci énormément

C'est même mieux que j'imaginais.

C'est vraiment nickel.

Le 08/05/2025 à 14:58

Désolé j'ai parlé trop vite.

Un petit problème:

Quand je lance l'extraction excel, le fichier initial (dans ce cas:ksiksi1-bouton-de-remplissage-de-tableau-sur-un-autre-fichier) change et les formules /mise en forme condionnelle sont effacé et remplacer par le tableau que j'ai extré en format valeur

Le 08/05/2025 à 16:48

Ok, je n'avais pas fais attention aux MFC, voici le code corrigé:

Dim DerLig_f3 As Long

Sub Export_Excel()
    Dim f1 As Worksheet, f3 As Worksheet
    Dim Crit21 As String, Crit2 As String, Nom_Classeur As String
    Dim DerLig_f1 As Long, NbLig As Long, i As Long
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set f1 = Sheets("BASE")
    Set f3 = Sheets("Sheet1")
    f3.Range("B3:O" & 10000).Clear
    DerLig_f1 = f1.Range("A" & Rows.Count).End(xlUp).Row
    f1.Range("A1:N" & DerLig_f1).Copy f3.Range("B3")

    'ne conserver que les CTP demandés
    DerLig_f3 = DerLig_f1 + 3
    Crit1 = f3.Range("A1").Value
    Crit2 = f3.Range("A2").Value
    For i = DerLig_f3 To 4 Step -1
        If f3.Cells(i, "C") <> "" And f3.Cells(i, "D") <> Crit1 And f3.Cells(i, "D") <> Crit2 Then f3.Rows(i).Delete
    Next i
    'Suppression  des colonnes "F2D, F2E,F3I"
    f3.Columns("K:M").Delete
    'Préparation^pour l'Export
    ActiveSheet.Copy
    Nom_Classeur = Application.GetSaveAsFilename 'sélectionnez le chemin et le nom à donner à cet enregistrement
    If Nom_Classeur <> Faux Then
        ActiveWorkbook.SaveAs Filename:=Nom_Classeur & ".xlsx" 'la feuille est enregistrée en tant que classeur prête à être expédiée
        ActiveSheet.Shapes.Range(Array("Picture 1")).Delete
        ActiveSheet.Shapes.Range(Array("ZoneTexte 1")).Delete
        Columns("A:A").Delete Shift:=xlToLeft
        FormatConditionnel
    End If
    Set f1 = Nothing
    Set f3 = Nothing
End Sub

Sub FormatConditionnel()
    Dim Plage_MFC As Excel.Range, FC1 As Excel.FormatCondition

    On Error Resume Next
    Range("I1").Select
    Set Plage_MFC = Range("I4:I" & DerLig_f3)
    Plage_MFC.FormatConditions.Delete

    Set FC1 = Plage_MFC.FormatConditions.Add(Type:=xlExpression, Formula1:="=$I4=0,95")
    FC1.Interior.Color = RGB(255, 192, 0)
    FC1.Font.Color = RGB(192, 0, 0)
End Sub

Cdlt

Le 09/05/2025 à 07:08

Bonjour

Le problème n'est pas sur le fichier exporté mais sur le fichier d'origine(source).(feuille Sheet1)

Une fois qu'on clique sur le bouton le tableau enlève les mise en forme ainsi que la formule "filtre" qui est sur la cellule B4.

Le 09/05/2025 à 10:13

Bonjour,

Dans ce cas il suffit de déplacer la ligne suivante pour appeler la macro du même nom:

FormatConditionnel

et de prendre la colonne J au lieu de I dans cette macro même macro

Dim DerLig_f3 As Long

Sub Export_Excel()
    Dim f1 As Worksheet, f3 As Worksheet
    Dim Crit21 As String, Crit2 As String, Nom_Classeur As String
    Dim DerLig_f1 As Long, NbLig As Long, i As Long
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set f1 = Sheets("BASE")
    Set f3 = Sheets("Sheet1")
    f3.Range("B3:O" & 10000).Clear
    DerLig_f1 = f1.Range("A" & Rows.Count).End(xlUp).Row
    f1.Range("A1:N" & DerLig_f1).Copy f3.Range("B3")

    'ne conserver que les CTP demandés
    DerLig_f3 = DerLig_f1 + 3
    Crit1 = f3.Range("A1").Value
    Crit2 = f3.Range("A2").Value
    For i = DerLig_f3 To 4 Step -1
        If f3.Cells(i, "C") <> "" And f3.Cells(i, "D") <> Crit1 And f3.Cells(i, "D") <> Crit2 Then f3.Rows(i).Delete
    Next i
    'Suppression  des colonnes "F2D, F2E,F3I"
    f3.Columns("K:M").Delete
    FormatConditionnel
    'Préparation^pour l'Export
    ActiveSheet.Copy
    Nom_Classeur = Application.GetSaveAsFilename 'sélectionnez le chemin et le nom à donner à cet enregistrement
    If Nom_Classeur <> Faux Then
        ActiveWorkbook.SaveAs Filename:=Nom_Classeur & ".xlsx" 'la feuille est enregistrée en tant que classeur prête à être expédiée
        ActiveSheet.Shapes.Range(Array("Picture 1")).Delete
        ActiveSheet.Shapes.Range(Array("ZoneTexte 1")).Delete
        Columns("A:A").Delete Shift:=xlToLeft
    End If
    Set f1 = Nothing
    Set f3 = Nothing
End Sub

Sub FormatConditionnel()
    Dim Plage_MFC As Excel.Range, FC1 As Excel.FormatCondition

    On Error Resume Next
    Range("I1").Select
    Set Plage_MFC = Range("J4:K" & DerLig_f3)
    Plage_MFC.FormatConditions.Delete

    Set FC1 = Plage_MFC.FormatConditions.Add(Type:=xlExpression, Formula1:="=$J4=0,95")
    FC1.Interior.Color = RGB(255, 192, 0)
    FC1.Font.Color = RGB(192, 0, 0)
End Sub

Cdlt

Le 09/05/2025 à 11:58

Le soucis viens peut être de "Then f3.Rows(i).Delete" dans le boucle.

Ceci efface le contenu du fichier initial ainsi que la formule au B4.

L'idée c'est vraiment de copier le contenu du tableau sheet1 dans le fichier source (selon la selection du CTP") et de coller les valeurs dans le nouveau fichier

Le 09/05/2025 à 16:21

Bonjour,

Je pense que vous n'avez pas bien compris. Après avoir cliquez sur le bouton "Préparation pour export excel", un nouveau classeur est crée ne contenant que la feuille filtrée, c'est ce classeur que vous avez sous les yeux, fermez-le et vous constaterez que le fichier original est bien présent et intact.

Cdlt

Le 12/05/2025 à 07:22

Bonjour

Je fait l'extraction et je ferme le nouveau fichier que j'ai généré mais sur le fichier initial je perd la formule du B4.

Est ce que vous pouvez m'envoyer votre fichier svp ? peut être que j'ai merder quelque part

Le 12/05/2025 à 10:15

Bonjour,

Le problème c'est que votre formule ne marche pas sur mon PC, la voici telle que je la vois dans la barre de formule:

 =FILTRE(_xlfn._TRO_TRAILING(BASE!A2:I282);(_xlfn._TRO_TRAILING(BASE!C2:C282)=$A$1)+(_xlfn._TRO_TRAILING(BASE!C2:C282)=$A$2);"ERROR")

si je la valide , toutes les données disparaissent, il faut la réécrire comme ceci en B4:

=FILTRE(BASE!A2:I282;(BASE!C2:C282=$A$1)+(BASE!C2:C282=$A$2);"ERROR")

et là, ça marche.

Cdlt

Le 12/05/2025 à 10:23

Bonjour,

La formule que j'ai sur mon fichier est bel est bien "=FILTRE(BASE!A2:I282;(BASE!C2:C282=$A$1)+(BASE!C2:C282=$A$2);"ERROR")" et pourtant à chaque fois que je clique sur le bouton d'extraction ça enlève la formule du fichier initial.

Le 12/05/2025 à 10:32

OK, alors il suffit de mettre en remarque la ligne suivante, c'est à dire mettre une apostrophe en début de ligne:

'f3.Range("B3:O" & 10000).Clear

le code en entier

Dim DerLig_f3 As Long

Sub Export_Excel()
    Dim f1 As Worksheet, f3 As Worksheet
    Dim Crit21 As String, Crit2 As String, Nom_Classeur As String
    Dim DerLig_f1 As Long, NbLig As Long, i As Long
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set f1 = Sheets("BASE")
    Set f3 = Sheets("Sheet1")
    'f3.Range("B3:O" & 10000).Clear
    DerLig_f1 = f1.Range("A" & Rows.Count).End(xlUp).Row
    f1.Range("A1:N" & DerLig_f1).Copy f3.Range("B3")

    'ne conserver que les CTP demandés
    DerLig_f3 = DerLig_f1 + 3
    Crit1 = f3.Range("A1").Value
    Crit2 = f3.Range("A2").Value
    For i = DerLig_f3 To 4 Step -1
        If f3.Cells(i, "C") <> "" And f3.Cells(i, "D") <> Crit1 And f3.Cells(i, "D") <> Crit2 Then f3.Rows(i).Delete
    Next i
    'Suppression  des colonnes "F2D, F2E,F3I"
    f3.Columns("K:M").Delete
    FormatConditionnel
    'Préparation^pour l'Export
    ActiveSheet.Copy
    Nom_Classeur = Application.GetSaveAsFilename 'sélectionnez le chemin et le nom à donner à cet enregistrement
    If Nom_Classeur <> Faux Then
        ActiveWorkbook.SaveAs Filename:=Nom_Classeur & ".xlsx" 'la feuille est enregistrée en tant que classeur prête à être expédiée
        ActiveSheet.Shapes.Range(Array("Picture 1")).Delete
        ActiveSheet.Shapes.Range(Array("ZoneTexte 1")).Delete
        Columns("A:A").Delete Shift:=xlToLeft
    End If
    Set f1 = Nothing
    Set f3 = Nothing
End Sub

Sub FormatConditionnel()
    Dim Plage_MFC As Excel.Range, FC1 As Excel.FormatCondition

    On Error Resume Next
    Range("I1").Select
    Set Plage_MFC = Range("J4:K" & DerLig_f3)
    Plage_MFC.FormatConditions.Delete

    Set FC1 = Plage_MFC.FormatConditions.Add(Type:=xlExpression, Formula1:="=$J4=0,95")
    FC1.Interior.Color = RGB(255, 192, 0)
    FC1.Font.Color = RGB(192, 0, 0)
End Sub

Cdlt

Le 12/05/2025 à 10:44

C'est toujours le même soucis.

La formule disparait :(

Le 12/05/2025 à 11:02

Question: A quoi vous sert la formule puisque le code fourni se charge de rapatrier les données de la feuille "Base" et ne conserve que celles répondant aux critères en A1 et An A2?

Edit: j'ai compris vous ne voulez pas forcément envoyer la feuille lorsque vous changez de critère donc, voici le nouveau fichier, la feuille "Sheets1" est recalculée dès que vous changez de critère.

11ksiksi1-bouton-de-remplissage-de-tableau-sur-un-autre-fichier-3.xlsm (144.50 Ko)

Le 12/05/2025 à 12:15

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("A1:A2")) Is Nothing Then Selection_CTP

End Sub

Un message d'erreur avec Selection_CTP non définie

sinon l'extraction marche très bien.

Aussi quand je vais faire l'impression en version papier la zone d'impression se met uniquement sur l'entête (vu que la feuille est recalculée à chaque fois qu'on sélectionne un CTP).J'aurais aimer la figer sur la longeur du tableau mais vu que ce n'est pas possible je me suis dit imprimer d'office 3 page à chaque fois

Le 12/05/2025 à 12:53

Ok, j'avais oublié de tester l'export après la modification, voici le fichier corrigé:

15ksiksi1-bouton-de-remplissage-de-tableau-sur-un-autre-fichier-3.xlsm (145.78 Ko)

Cdlt

Le 12/05/2025 à 14:14

Désolé je t'embêter avec ça mais je pense que c'était mieux avec la formule en B4 par ce que là la zone d'impression se décale à chaque fois et les MFC sur le fichier initial n'apparaissent plus .

L'idée était de créer un fichier à partir du fichier source en copiant uniquement les valeurs et la MFC(si possible) selon le choix du CTP.

Si c'est pas possible de faire de la sorte dit moi et je verrais pour faire autrement ou manuellement

Le 12/05/2025 à 16:22

Non, les formules ne changeront rien, il faut simplement recalculer la zone d'impression, voilà qui est fait dans le code du nouveau fichier.

12ksiksi1-bouton-de-remplissage-de-tableau-sur-un-autre-fichier-3.xlsm (148.18 Ko)

Le 12/05/2025 à 16:45

parfait !!

Merci beaucoup

Rechercher des sujets similaires à "bouton remplissage tableau fichier"