Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

babie971

XLDnaute Nouveau
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,
 

Pièces jointes

  • Fichier d'Importation.xlsx
    40.3 KB · Affichages: 16
  • Modèle Extraction.xlsx
    28.2 KB · Affichages: 9

bouchard

XLDnaute Nouveau
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

VB:
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
 

Pièces jointes

  • Fichier d'Importation.xlsm
    41 KB · Affichages: 1

babie971

XLDnaute Nouveau
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.
 

Pièces jointes

  • Fichier d'Importation.xlsm
    56.7 KB · Affichages: 6

bouchard

XLDnaute Nouveau
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
 

Pièces jointes

  • Fichier d'Importation.xlsm
    43.1 KB · Affichages: 3

babie971

XLDnaute Nouveau
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

XLDnaute Nouveau
 

bouchard

XLDnaute Nouveau
Bonjour Babie971,
j'ai ajouté deux séquences qui pourraient répondre à votre besoin.
Code:
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

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

Discussions similaires

M
Réponses
9
Affichages
753
Maikales
M
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…