Importation des données des feuilles d'un fichier vers un tableau Unique

JONEY76

XLDnaute Occasionnel
Bonsoir à tous,

Je suis en train de créer une application avec plusieurs fonctions

- Remplir un formualire : Lorsque le formulaire est rempli, cela crée un feuille excel unique qui est enregistrée sous un nom et numéro incrémenté dans un dossier nommé Data

- Ouvrir une fiche existante : Une listbox affiche toutes les fiches crée qui sont rangées dans le dossier DATA

- Rechercher un mot clé (nom de fiche etc)


Je souhaiterai savoir si il est possible de remplir un tableau unique sur un nouveau classeur avec le contenu de toutes les fiches du dossier DATA (une trentaine de cellules non alignées)

Ceci dans le but de connaitre toutes les mises à jour effectuée sur telle ou telle fiche

Déposer un fichier va être compliqué je pense


Merci d'avance pour votre aide
 

JONEY76

XLDnaute Occasionnel
Re : Importation des données des feuilles d'un fichier vers un tableau Unique

Pour chaque fichier excel contenu dans le dossier data
Ouvrir chaque fichier excel
sélectionner les données en a1, b15, d14
copier
Ouvrir le fichier tableau dans le dossier Global
coller les données

ouvrir le deuxième fichier


C'est pour transposer ceci en VBA que je coince...
 

Grand Chaman Excel

XLDnaute Impliqué
Re : Importation des données des feuilles d'un fichier vers un tableau Unique

Bonsoir Joney76,

Il y a plusieurs méthodes possibles, mais voici un bout de code que j'utilise pour ce genre de tâche. Bien entendu, tu devras l'adapter à ton cas précis.

VB:
'------------------------------------------------------------------------------
' Macro qui permet de compiler les informations contenues dans
' différents fichier pour les regrouper dans un fichier récapitulatif
' GCXL
'-------------------------------------------------------------------------------
Sub Creer_Recapitulatif()
    Dim wbRecap As Workbook         'fichier recap
    Dim wsRecap 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 rgRecap As Range            'plage où on copie les données


    Set wbRecap = ThisWorkbook       'Fichier récapitulatif
    Set wsRecap = wbRecap.Sheets(1)  '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é
    If Not IsArray(vFichiers) Then
        MsgBox "Erreur! Aucun/Mauvais fichier sélectionné."
        Exit Sub
    End If
    On Error Resume Next
    
    Application.ScreenUpdating = False
    
    ' --- Boucle à travers les fichiers
    For k = 1 To UBound(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(1)                                  'On copie les données de la feuille 1
        DernLign = wbRecap.Sheets(1).Range("A60000").End(xlUp).Row + 1     'ligne pour écrire le log des fichiers compilés
    
        
        ' - On copie les données vers le fichier Recapitulatif; à adapter
        Set rgRecap = wsRecap.Range("A65000").End(xlUp).Offset(1, 0)
        rgRecap = Time
        With wsSource
            rgRecap.Offset(0, 1) = .Range("B7")
            rgRecap.Offset(0, 2) = .Range("B8")
            rgRecap.Offset(0, 3) = .Range("B10")
            rgRecap.Offset(0, 4) = .Range("B13")
            rgRecap.Offset(0, 5) = .Range("B14")
        End With

        wbSource.Close              'fermer fichier
        Set wbSource = Nothing
        ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Next k
    
    Application.ScreenUpdating = True
    Application.StatusBar = False

End Sub

Function Selectionner_Fichiers(sTitre As String) As Variant
    Dim sFiltre As String, bMultiSelect As Boolean
    
    sFiltre = "Fichiers XYZ (.xls)(.xlsm), *.xls*"
    bMultiSelect = True 'Permet de choisir plusieurs fichiers à la fois
    Selectionner_Fichiers = Application.GetOpenFilename(Filefilter:=sFiltre, Title:=sTitre, MultiSelect:=bMultiSelect)
End Function

A+
 

Statistiques des forums

Discussions
284 906
Messages
1 864 038
Membres
155 741
dernier inscrit
khayal boutaina
Haut Bas