XL 2019 Création fichier par importation d'onglets de 3 fichiers + mise en page

[babie971]

Bonjour,

J’espère que vous allez bien !

Je souhaite créer un fichier mensuel en important séparément des onglets de plusieurs fichiers en tenant compte des spécificités ci-après :

• insertion de colonne
• mise en page
• rendre des colonne et lignes calculer , entre autres ...

le reste de détail des modifications souhaitées pour rendre le fichier exploitable se trouve dans la feuille récap.

Objectifs : depuis un fichier modèle : utiliser plusieurs boutons pour chaque type de fichier à importer grâce à un VBA.

en pj :
le "fichier d'importation" que je souhaite en format modèle
le fichier "modèle d'extraction"
Je vous remercie d'avance pour toute l'aide que vous pourrez m'apporter.

Et restant bien évidemment disponible si les informations apportées nécessite des précisions.


Bien à vous,

 

[bouchard]

Bonjour,
je veux bien commencer.
En premier il faut enregistrer "fichier d'importation" en ".xlsm"
En deux, ajouter les lignes suivantes dans un module et affecter au premier bouton cette procédure ( qu'i faudra compléter bien sûr)
Voir résultat en pj

Sub ImportDonnéesContinues()
    Set wt = ActiveWorkbook
    fic = Application.GetOpenFilename("Données continues,*.xl*")
    If Not fic = False Then
        Set wo = Workbooks.Open(fic)
        n = wo.Sheets.Count
        Do While n > 0
            If wo.Sheets(n).Name <> "Récap" Then
                wo.Sheets(n).Copy before:=wt.Sheets(2)
                '... Traitements et mises en forme
            End If
            n = n - 1
        Loop
        'wo.Close
    End If
End Sub

 

[babie971]

Bonjour Bouchard !

C'est génial, je suis vraiment contente de ce très gros coup de pousse, je vais tenter la suite.
Je vous donnerai des nouvelles de mon avancement .
Bon Lundi de Pâques

 

[babie971]

Encore merci Bouchard,
ci-joint le fichier avec une bonne partie des mises en page réalisées (les plus simples).
Le plus dure reste à venir, mais c'est déjà pas mal . je me permettrai de t'appeler à l'aide si je coince.
Merci merci de m'avoir permis de mettre le pied à l'étrier.

 

[bouchard]

Bonjour Babie971
Quelques remarques
pour une compréhension plus fluide du code, plus que les commentaires, c'est de bien afficher l'indentation (voir fichier)

une erreur ?
Range("AL4").EntireColumn.Insert 'Insertion Ind. Hab. Déshab jr en AL
Range("AL5").Value = "Ind. Hab. Déshab jr" -> Range("AL4")?
et suivant

Mise en pages des feuilles
... est relancée à chaque insertion
doit être déplacé en fin de boucle

Je n'ai pas testé mais ça a l'air de bien avancé. C'est un bon début

 

[babie971]

Bonjour Babie971
Quelques remarques
pour une compréhension plus fluide du code, plus que les commentaires, c'est de bien afficher l'indentation (voir fichier)

une erreur ?
Range("AL4").EntireColumn.Insert 'Insertion Ind. Hab. Déshab jr en AL
Range("AL5").Value = "Ind. Hab. Déshab jr" -> Range("AL4")?
et suivant

Mise en pages des feuilles
... est relancée à chaque insertion
doit être déplacé en fin de boucle

Je n'ai pas testé mais ça a l'air de bien avancé. C'est un bon début

Bonsoir Bouchard,

encore merci merci pour votre aide:
- J'ai modifié l'erreur
- j'ai compris l'intérêt de l'indentation (je ne connaissais pas du tout ce terme)
- je souhaite effectivement que "mise en pages des feuilles) fonctionne sur toutes les pages d'où cette emplacement
ça ne fonctionne pas sur toutes feuilles quand je le place après la boucle auriez-vous une suggestion.

de plus je bugge sur 2 autres besoins :

- rendre la dernière ligne en somme des colonnes

j'ai trouvé cette fonction mais elle somme mon total existant avec
Sub somme()
Range("E" & Rows.Count).End(xlUp).Row + 1).Value = Application.WorksheetFunction.Sum(Range("E" & Rows.Count).End(xlUp).Row))
End Sub

- Faire en sorte de chaque feuille soit sur une page center horizontalement et verticalement.

 

[bouchard]

Bonsoir Bouchard,

encore merci merci pour votre aide:
- J'ai modifié l'erreur
- j'ai compris l'intérêt de l'indentation (je ne connaissais pas du tout ce terme)
- je souhaite effectivement que "mise en pages des feuilles) fonctionne sur toutes les pages d'où cette emplacement
ça ne fonctionne pas sur toutes feuilles quand je le place après la boucle auriez-vous une suggestion.

de plus je bugge sur 2 autres besoins :

- rendre la dernière ligne en somme des colonnes

j'ai trouvé cette fonction mais elle somme mon total existant avec
Sub somme()
Range("E" & Rows.Count).End(xlUp).Row + 1).Value = Application.WorksheetFunction.Sum(Range("E" & Rows.Count).End(xlUp).Row))
End Sub

- Faire en sorte de chaque feuille soit sur une page center horizontalement et verticalement.

 

[bouchard]

Bonjour Babie971,
j'ai ajouté deux séquences qui pourraient répondre à votre besoin.

Sub ImportDonnéesContinu()
    Set wt = ActiveWorkbook
    fic = Application.GetOpenFilename("Données continues,*.xl*")
    If Not fic = False Then
        Set wo = Workbooks.Open(fic)
        n = wo.Sheets.Count
        Do While n > 0
            If wo.Sheets(n).Name <> "Récap" Then
                wo.Sheets(n).Copy after:=wt.Sheets(1)
                wt.Activate
                Set ft = ActiveSheet
                '....
                nl = ft.Columns(1).Find("Mois").Row
                vt = nl & ":" & nl + 5
                ft.Rows(vt).Delete Shift:=xlUp
                ft.Range("A" & nl) = "Mois de " & Format((ft.Range("A" & nl - 1)), "MMMM")
                ft.Range("E" & nl).FormulaR1C1 = "=SUM(R[-31]C:R[-1]C)"
                ft.Range("E" & nl).Copy
                ft.Range("F" & nl & ":AM" & nl).Select
                ActiveSheet.Paste
                '.....
                With ft.Cells
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                End With
                '...
            End If
            n = n - 1
        Loop
        wo.Close
    End If
End Sub

Bonne continuation

 

[babie971]

Bonjour Babie971,
j'ai ajouté deux séquences qui pourraient répondre à votre besoin.

Sub ImportDonnéesContinu()
    Set wt = ActiveWorkbook
    fic = Application.GetOpenFilename("Données continues,*.xl*")
    If Not fic = False Then
        Set wo = Workbooks.Open(fic)
        n = wo.Sheets.Count
        Do While n > 0
            If wo.Sheets(n).Name <> "Récap" Then
                wo.Sheets(n).Copy after:=wt.Sheets(1)
                wt.Activate
                Set ft = ActiveSheet
                '....
                nl = ft.Columns(1).Find("Mois").Row
                vt = nl & ":" & nl + 5
                ft.Rows(vt).Delete Shift:=xlUp
                ft.Range("A" & nl) = "Mois de " & Format((ft.Range("A" & nl - 1)), "MMMM")
                ft.Range("E" & nl).FormulaR1C1 = "=SUM(R[-31]C:R[-1]C)"
                ft.Range("E" & nl).Copy
                ft.Range("F" & nl & ":AM" & nl).Select
                ActiveSheet.Paste
                '.....
                With ft.Cells
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                End With
                '...
            End If
            n = n - 1
        Loop
        wo.Close
    End If
End Sub

Bonne continuation

Super Merci beaucoup ça fonctionne très très bien