VBA ficher de synthèse de +classeurs Excel sans les ouvrir

Le 29/09/2017 à 14:30

Bonjour à tous!

Dans le cadre de mon travail j'ai besoin de faire une macro qui me permettrait de construire un fichier de synthèse à partir de plusieurs classeurs excels. Je sais que la méthode est déjà sur ce forum or je n'ai pas trouvé des solutions à certains de mes problèmes. avant d'expliquer mon problème je dois vous dire que je suis trop nulle en VBA donc j'essaie de me débrouiller avec les codes sur les forums.

Voici le contexte:

J'ai un fichier de de synthèse et dans son premier onglet je veux rassembler certains informations qui se trouvent dans plusieurs autres classeurs excels

D'abord ma macro supprime tout ce qui est sur la feuille et remet les titres (pour éviter les modifications/oublies d'informations)

Ensuite il me demande de sélectionner les classeurs à partir desquels je veux importer les données (je peux sélectionner plusieurs fichiers)

Ces derniers classeurs sont nommées différemment chacun mais la forme de leurs feuilles sont tous identiques (ex: la cellule A2 de chacun de ces classeurs correspond à un code modèle) etc. Les nom des feuilles sont également identiques

Mes problèmes:

La macro m'autorise à choisir plusieurs fichiers OR n'importe pas les données du 2ème fichier et s'arrête au premier

Au moment de l'importation des données la macro OUVRE chacun de ces classeurs excel donc pour chaque fichier il me demande "mettre à jour les données/ne pas mettre à jour les données etc." ET à la fin me demande si je veux enregistrer ou pas.

Sachant que dans l'objectif je devra avoir environ 40 fichiers à compiler, cela ne me semble pas du tout pratique !

J'ai besoin que la macro importe les données de ces plusieurs fichiers sans les ouvrir à chaque fois ! Pouvez-vous m'aider à trouver la solution SVP??

Mille merci d'avance !

Hzl

30classeur2.xlsm (15.06 Ko)
Le 30/09/2017 à 02:54

Bonjour,

le première item d'un Array a l'indice 0

donc vFichiers(0) = premier fichier sélectionné.

il faudrait que la boucle soit For k = 0 To UBound(vFichiers)

ou bien For k = LBound(vFichiers) To UBound(vFichiers)

Le 01/10/2017 à 14:38

Bonjour xxhzlxx, sabV

' Quelques Corrections de principe >voir dans le code corrigé/commenté !

' Attention a l'indentation !!
' ----------------------------------------------------------------------

' PS/   je n'ai fait que des corrections de principes parce que nous les informaticiens
'       sans exemple, sans PJ on ne sait pas travailler
'       et encore moins (et comme beaucoup de gens) lire dans la tête de ceux qui posent les questions !

' Macro qui permet de compiler les informations contenues dans
' différents fichier pour les regrouper dans un fichier récapitulatif
' GCXL
'-------------------------------------------------------------------------------
Sub Creer_Import()
Dim wbSyntheseBRO As Workbook         'fichier synthese
Dim wsSynthese As Worksheet        'feuille où on écrit les données
Dim wbSource As Workbook            'fichier à ouvrir
Dim wsSource As Worksheet           'feuille où on cherche les données
Dim DernLign As Integer             'ligne où on écrit les données
Dim vFichiers As Variant            'noms des fichiers
Dim i As Integer, k As Integer
Dim rgSynthese As Range            'plage où on copie les données

    Set wbSyntheseBRO = ThisWorkbook       'Fichier récapitulatif
    Set wsSynthese = wbSyntheseBRO.Sheets("Synthese")  'on écrit dans la feuille 1 du fichier récapitulatif

    ' --- Ouvrir boite de dialogue pour sélectionner les fichiers à ouvrir
    vFichiers = Selectionner_Fichiers("Sélectionner les fichiers à compiler") 'Appel de Fonction pour ouvrir fichiers

    ' --- Vérifier qu'au moins un fichier à été sélectionné

    ' à mon avis il faut tourner le test dans l'autre sens => c'est plus logique de faire ce qui fonctionne en 1er
    ' et de traiter les cas particulier ensuite
    'If Not IsArray(vFichiers) Then
    '    Debug.Print "Aucun fichier sélectionné."
    '    MsgBox "Erreur! Aucun/Mauvais fichier sélectionné."
    '    Exit Sub
    'End If

    ' de plus il est plus logique de traiter "une NON selection" comme cela

    If Not VarType(vFichiers) = vbBoolean Then
        ' ainsi nous savons que l'utilisateur a selectionne au moin un fichier
        ' parce que si vFichiers est booleen c'est que l'utilisateur a appuyé sur Annuler !
        ' si il n'y en a que 1 c'est quand même un tableau qui commence a 0 et qui dans ce cas precis
        ' se termine egalement à 0

        ' ATTENTION !!!
        ' l'utilisation de On Error Resume Next est TRES dangeureuse sans etre capable de maitriser la suite du code !
        '                  --------------------
        ' donc on le mettra seulement au cas où l'on peut maitriser la suite du deroulement
        ' On Error Resume Next

        Application.ScreenUpdating = False

        ' --- Boucle à travers les fichiers

        'For k = 1 To UBound(vFichiers)
        ' comme le precise sabV et plus haut (moi même) l'indice commence à 0 !
        ' pour être certain de ne pas se tromper
        ' LBound pour LowerBound ou LimiteBasse pour les francophiles
        ' UBound pour UpperBound ou LimiteHaute pour les mêmes
        For k = LBound(vFichiers) To unound(vFichiers)
            Application.StatusBar = ">> Lecture du fichier #" & k & "/" & UBound(vFichiers)

            ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            ' C'est ici qu'on écrit les instructions
            Set wbSource = Workbooks.Open(vFichiers(k))                                 'on ouvre le fichier
            Set wsSource = wbSource.Sheets("Prix")                                      'On copie les données de l'onglet Prix
            ' suggestion :
            ' Range("A65000") ne donne pas forcement la derniere ligne Excel
            ' depuis de nombreuses versions Excel dispose de 1 0485 76 lignes
            ' la bonne utilisation est donc cells(rows.count,1).end(xlup).row +1
            ' qui fonctionne avec toutes les versions
            DernLign = wbSynthese.Sheets("Synthese").Range("A65000").End(xlUp).Row + 1      'ligne pour écrire le log des fichiers compilés

            ' - On copie les données vers le fichier Synthese; à adapter
            Set rgSynthese = wsSynthese.Range("A65000").End(xlUp).Offset(1, 0)

            With wsSource

                wbSource.Sheets("Prix").Range("G2").Copy ThisWorkbook.Sheets("Synthese").Range("A2")
                wbSource.Sheets("Prix").Range("G3").Copy ThisWorkbook.Sheets("Synthese").Range("B2")
                wbSource.Sheets("Prix").Range("G4").Copy ThisWorkbook.Sheets("Synthese").Range("C2")
                wbSource.Sheets("Prix").Range("G5").Copy ThisWorkbook.Sheets("Synthese").Range("D2")
                wbSource.Sheets("Prix").Range("G6").Copy ThisWorkbook.Sheets("Synthese").Range("E2")
                wbSource.Sheets("Prix").Range("G7").Copy ThisWorkbook.Sheets("Synthese").Range("F2")
                wbSource.Sheets("Prix").Range("G8").Copy ThisWorkbook.Sheets("Synthese").Range("G2")
                wbSource.Sheets("Prix").Range("AF3").Copy ThisWorkbook.Sheets("Synthese").Range("H2")
                wbSource.Sheets("Prix").Range("AJ1").Copy ThisWorkbook.Sheets("Synthese").Range("I2")
                wbSource.Sheets("Prix").Range("AJ2").Copy ThisWorkbook.Sheets("Synthese").Range("J2")
                wbSource.Sheets("Prix").Range("AJ33").Copy ThisWorkbook.Sheets("Synthese").Range("K2")
                wbSource.Sheets("Prix").Range("AJ34").Copy ThisWorkbook.Sheets("Synthese").Range("L2")
                wbSource.Sheets("Prix").Range("AJ35").Copy ThisWorkbook.Sheets("Synthese").Range("M2")

            End With

            wbSource.Close                                                      'fermer fichier

            ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        Next k
    Else
        ' on traite les cas particulier a la fin !
        MsgBox "Pas de fichier selectionne !"
    End If

    Application.ScreenUpdating = True
    Application.StatusBar = False

End Sub

Function Selectionner_Fichiers(sTitre As String) As Variant
Dim sFiltre As String, bMultiSelect As Boolean

    ' à mon avis *.xls* et non *.xlsm sinon tu n'auras pas *.xls tout court !!
    sFiltre = "Fichiers XYZ (.xls)(.xlsm), *.xlsm*"
    bMultiSelect = True 'Permet de choisir plusieurs fichiers à la fois
    Selectionner_Fichiers = Application.GetOpenFilename(Filefilter:=sFiltre, Title:=sTitre, MultiSelect:=bMultiSelect)

End Function

Sub proprietes()
    'Modifier la taille du texte des cellules A1 à A8
    'Range("A2:M60000").Font.Size = 11
    'Range("A2:M60000").Font.Name = "Calibri"
    'Range("A2:M60000").Font.Bold = False
    'Range("A2:M60000").Borders.Value = 0
    'Range("A2:M60000").Font.ColorIndex = 1

    ' simplification d'ecriture et rapidite du code
    With Range("A2:M60000")
        With .Font
            .Size = 11
            .Name = "Calibri"
            .Bold = False
            .ColorIndex = 1
        End With
        .Borders.Value = 0
    End With

End Sub
Le 02/10/2017 à 12:16

Bonjour SabV, j'ai fait la modif mais j'ai toujours le même problème.. les fichiers s'ouvrent et j'obtiens que les données du premier fichier.

NCC701, merci pour ta réponse très détaillée! Mais malheureusement cela ne marche pas.. j'arrive à sélectionner les fichiers, la macro commence à ouvrir à nouveau les fichiers ... Or même avant d'importer les données il me sort le message d'erreur "Objet requis" et surligne cette ligne de code:

 DernLign = wbSynthese.Sheets("Synthese").Range("A65000").End(xlUp).Row + 1      'ligne pour écrire le log des fichiers compilés

J'espère que vous auriez la solution! Un grand merci en tout cas!

Le 02/10/2017 à 12:26

Bonjour (..)

 DernLign = wbSynthese.Sheets("Synthese").Range("A65000").End(xlUp).Row + 1      'ligne pour écrire le log des fichiers compilés

pourquoi mettre

wbSynthese.Sheets("Synthese")....

alors que

Set wsSynthese = wbSyntheseBRO.Sheets("Synthese")

est défini en haut du programme...

je pense que

DernLign = wbSynthese.Range("A65000").End(xlUp).Row + 1

est amplement suffisant !

Maintenant il est vrai que je n'avais pas vu cette erreur, cependant sans fichier pour tester il est plus difficile de voir tous les bugs en même temps !

cf. https://forum.excel-pratique.com/annonces/explications-et-regles-a-respecter-t13.html point 6 en particulier !

Le 02/10/2017 à 13:18

Merci beaucoup pour votre réactivité! En revanche j'ai essayé mais cela ne marche toujours pas.. j'ai le meme message d'erreur concernant cette meme ligne !

Et j'avais bien rajouté un fichier en pièces jointe quand j'ai posé ma question! Je ne peux pas joindre les fichiers source car il y a des données confidentielles dedans mais le but c'est que la macro aille récuperer les données d'un onglet quelconque nommé "Prix" d'un fichier qu'on aura sélectionnée, donc la source peut etre n'importe quel fichier!

Le 02/10/2017 à 13:46

(re)

Données Confidentielles

Tu travailles à la NSA, ou au KGB ?

Rechercher des sujets similaires à "vba ficher synthese classeurs ouvrir"