IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Synthétiser dans un Workbook les Data de plusieurs Workbooks (Excel)


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Nouveau candidat au Club
    Homme Profil pro
    Ingenieur Terrain
    Inscrit en
    Février 2017
    Messages
    2
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Gard (Languedoc Roussillon)

    Informations professionnelles :
    Activité : Ingenieur Terrain
    Secteur : Industrie

    Informations forums :
    Inscription : Février 2017
    Messages : 2
    Par défaut Synthétiser dans un Workbook les Data de plusieurs Workbooks (Excel)
    Bonjour a tous,

    Je cherche a adapter le programme suivant car celui ci fonctionne mais copie correctement uniquement les données en Range de plusieurs cellules successives d'une ligne (Set sourceRange = .Range("J24:P24")).
    Ce que je cherche a faire c'est récupérer les données de plusieurs cellules ( B4 D4 F5 A8 M4 J24 L24 O24) de mes fichiers source et de les synthétiser sur une seule ligne a chaque fois sur mon fichier de destination.

    Voici mon code:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    Sub MergeAllWorkbooks()
        Dim MyPath As String, FilesInPath As String
        Dim MyFiles() As String
        Dim SourceRcount As Long, FNum As Long
        Dim mybook As Workbook, BaseWks As Worksheet
        Dim sourceRange As Range, destrange As Range
        Dim rnum As Long, CalcMode As Long
     
        ' Change this to the path\folder location of your files.
        MyPath = "C:\Users\G502089\Desktop\IATA\AAAA"
     
        ' Add a slash at the end of the path if needed.
        If Right(MyPath, 1) <> "\" Then
            MyPath = MyPath & "\"
        End If
     
        ' If there are no Excel files in the folder, exit.
        FilesInPath = Dir(MyPath & "*.xl*")
        If FilesInPath = "" Then
            MsgBox "No files found"
            Exit Sub
        End If
     
        ' Fill the myFiles array with the list of Excel files
        ' in the search folder.
        FNum = 0
        Do While FilesInPath <> ""
            FNum = FNum + 1
            ReDim Preserve MyFiles(1 To FNum)
            MyFiles(FNum) = FilesInPath
            FilesInPath = Dir()
        Loop
     
        ' Set various application properties.
        With Application
            CalcMode = .Calculation
            .Calculation = xlCalculationManual
            .ScreenUpdating = False
            .EnableEvents = False
        End With
     
        ' Add a new workbook with one sheet.
        Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
        rnum = 1
     
        ' Loop through all files in the myFiles array.
        If FNum > 0 Then
            For FNum = LBound(MyFiles) To UBound(MyFiles)
                Set mybook = Nothing
                On Error Resume Next
                Set mybook = Workbooks.Open(MyPath & MyFiles(FNum))
                On Error GoTo 0
     
                If Not mybook Is Nothing Then
                    On Error Resume Next
     
                    ' Change this range to fit your own needs.
                    With mybook.Worksheets(1)
                        Set sourceRange = .Range("J24:P24")
     
                    End With
     
                    If Err.Number > 0 Then
                        Err.Clear
                        Set sourceRange = Nothing
                    Else
                        ' If source range uses all columns then
                        ' skip this file.
                        If sourceRange.Columns.Count >= BaseWks.Columns.Count Then
                            Set sourceRange = Nothing
                        End If
                    End If
                    On Error GoTo 0
     
                    If Not sourceRange Is Nothing Then
     
                        SourceRcount = sourceRange.Rows.Count
     
                        If rnum + SourceRcount >= BaseWks.Rows.Count Then
                            MsgBox "There are not enough rows in the target worksheet."
                            BaseWks.Columns.AutoFit
                            mybook.Close savechanges:=False
                            GoTo ExitTheSub
                        Else
     
                            ' Copy the file name in column A.
                            With sourceRange
                                BaseWks.Cells(rnum, "A"). _
                                        Resize(.Rows.Count).Value = MyFiles(FNum)
                            End With
     
                            ' Set the destination range.
                            Set destrange = BaseWks.Range("B" & rnum)
     
                            ' Copy the values from the source range
                            ' to the destination range.
                            With sourceRange
                                Set destrange = destrange. _
                                                Resize(.Rows.Count, .Columns.Count)
                            End With
                            destrange.Value = sourceRange.Value
     
                            rnum = rnum + SourceRcount
                        End If
                    End If
                    mybook.Close savechanges:=False
                End If
     
            Next FNum
            BaseWks.Columns.AutoFit
        End If
     
    ExitTheSub:
        ' Restore the application properties.
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
            .Calculation = CalcMode
        End With
    End Sub

  2. #2
    Expert éminent Avatar de Menhir
    Homme Profil pro
    Ingénieur
    Inscrit en
    Juin 2007
    Messages
    16 037
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : Ingénieur
    Secteur : Industrie

    Informations forums :
    Inscription : Juin 2007
    Messages : 16 037
    Par défaut
    Il suffit de les copier cellule par cellule avec une succession de copy.
    https://msdn.microsoft.com/fr-fr/lib.../ff837760.aspx

    J'ai regardé ton code rapidement. Ca me semble extrêmement compliqué pour faire ça.
    En plus, c'est plein de On Error, ce qui, pour moi, est très beurk.

    Comment sont déterminés les fichiers sources à traiter ?

  3. #3
    Membre Expert
    Homme Profil pro
    PAO
    Inscrit en
    Octobre 2014
    Messages
    2 576
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : PAO
    Secteur : Communication - Médias

    Informations forums :
    Inscription : Octobre 2014
    Messages : 2 576
    Par défaut
    Bonjour,
    .
    Une solution simple à chaque fois que l'on boucle sur un classeur source, serait de concaténer les valeurs de B4 D4 F5 A8 M4 J24 L24 O24 et une fois fini, d'appliquer un texttocolumns sur la range concernée

    Dans la boucle:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    With Workbooks(monclasseursource).sheets(mafeuille)
       Workbooks(ClasseurDestination).sheets(mafeuille).Range("A" & derL + i).Value = ici mettre la concaténation 
    End With
    À la fin du code : faire le texttocolumns en indiquant le séparateur choisi pour la concaténation à partir de la ligne de départ jusqu'à la dernière ligne

    Edit : correction, dsl je suis sur mon phone

    Edit 2 : un exemple hyper simplifié
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    Sub test()
    'C'est un exemple, aucune boucle sur classeurs, aucun pointages, donc à adapter
        'Destination = concaténation Source
        Range("A9") = Range("A1") & "_" & Range("B3") & "_" & Range("C1") & "_" & Range("D5") & "_" & Range("E4")
     
        'Plage de destination à traiter => en commençant sur la plage de départ
        Range("A9").TextToColumns Destination:=Range("A9"), DataType:=xlDelimited, Other:=True, OtherChar:="_"
        'on aurrait pu avoir : Range("A9:A14").TextToColumns Destination:=Range("A9"), DataType:=xlDelimited, Other:=True, OtherChar:="_"
     
    End Sub
    Cordialement
    Ryu

    La connaissance s’acquiert par l’expérience, tout le reste n’est que de l’information. – Albert Einstein

    Pensez à la Balise [ CODE][/CODE ] - à utiliser via le bouton # => Exemple

    Une fois votre problème solutionné pensez à mettre :resolu: en n'oubliant pas d'indiquer qu'elle est la solution finale choisie ;)

  4. #4
    Nouveau candidat au Club
    Homme Profil pro
    Ingenieur Terrain
    Inscrit en
    Février 2017
    Messages
    2
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Gard (Languedoc Roussillon)

    Informations professionnelles :
    Activité : Ingenieur Terrain
    Secteur : Industrie

    Informations forums :
    Inscription : Février 2017
    Messages : 2
    Par défaut
    Merci pour vos réponses. Je vais tenter les deux méthodes. Je reviens vers vous pour vous donner mes résultats.

Discussions similaires

  1. Charger dans une TreeMap les données d'une feuille Excel
    Par oumouRaby dans le forum Documents
    Réponses: 13
    Dernier message: 08/05/2016, 10h04
  2. [MySQL] regrouper dans un tableau les donnée de plusieur table SQL
    Par Mais.Ouais dans le forum PHP & Base de données
    Réponses: 2
    Dernier message: 20/05/2009, 10h47
  3. récuperé dans une feuille les donnés de plusieur classeurs fermé
    Par peygase83 dans le forum Macros et VBA Excel
    Réponses: 0
    Dernier message: 10/02/2009, 18h31
  4. Réponses: 5
    Dernier message: 23/04/2007, 13h37
  5. revalider les datas insérées dans un formulaire
    Par capouille dans le forum Access
    Réponses: 2
    Dernier message: 19/04/2006, 06h37

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo