macro fusion de plusieurs fichiers en un seul

Y compris Power BI, Power Query et toute autre question en lien avec Excel
c
claude.dasilva
Nouveau venu
Nouveau venu
Messages : 5
Inscrit le : 3 novembre 2016
Version d'Excel : 2010

Message par claude.dasilva » 3 novembre 2016, 22:04

Bonjour à tous,

Voilà question sûrement simple pour beaucoup mais sur laquelle je lutte depuis quelques jours...
J'ai plusieurs fichiers excel avec le même format (j'ai mis un exemple dans la feuil1 du fichier joint) que je mets dans un dossier.
J'ai créé une macro pour récupérer certaines cellules de ces formulaires pour coller dans un tableau (en feuil2 du fichier joint).
Les cellules sont éparpillés dans le formulaire, dans le fichier de synthèse, je veux mettre ces cellules en ligne, chaque valeur correspond à un titre de colonne. Et je passe à la ligne pour le formulaire suivant.
La macro que j'ai créé récupère bien toutes les données mais il me copie toutes les valeurs les une derrière les autres en colonne. Il va à la ligne pour chaque cellule copiée.

Merci pour votre aide et conseils...

Ci-joint le code :
Option Explicit

Sub importDonnees()
Dim principal As ThisWorkbook
Dim repertoire As String, fichier As String
Application.ScreenUpdating = False
Set principal = ThisWorkbook
repertoire = ThisWorkbook.Path
ChDir repertoire
fichier = Dir("*.xlsm")
Do While fichier <> ""
If fichier <> principal.Name Then
Workbooks.Open fichier
On Error GoTo suivant
With Sheets("FEM")
On Error GoTo 0
On Error Resume Next
.Range("B8").Copy Destination:=principal.Sheets(1).[a65536].End(xlUp).Offset(1)
.Range("D8").Copy Destination:=principal.Sheets(1).[a65536].End(xlUp).Offset(1)
.Range("B11").Copy Destination:=principal.Sheets(1).[a65536].End(xlUp).Offset(1)
.Range("B13").Copy Destination:=principal.Sheets(1).[a65536].End(xlUp).Offset(1)
.Range("B15").Copy Destination:=principal.Sheets(1).[a65536].End(xlUp).Offset(1)
.Range("C15").Copy Destination:=principal.Sheets(1).[a65536].End(xlUp).Offset(1)
.Range("G15").Copy Destination:=principal.Sheets(1).[a65536].End(xlUp).Offset(1)
.Range("C19").Copy Destination:=principal.Sheets(1).[a65536].End(xlUp).Offset(1)
.Range("A28").Copy Destination:=principal.Sheets(1).[a65536].End(xlUp).Offset(1)
.Range("A42").Copy Destination:=principal.Sheets(1).[a65536].End(xlUp).Offset(1)
End With
ActiveWorkbook.Close False
End If
suivant:
If Err.Number = 9 Then MsgBox "Pas de feuille ""FEM"" dans le fichier " & fichier, vbExclamation: ActiveWorkbook.Close False
fichier = Dir
Loop
End Sub
Classeur1.xlsx
(10.73 Kio) Téléchargé 39 fois
Avatar du membre
Steelson
Fanatique d'Excel
Fanatique d'Excel
Messages : 13'206
Appréciations reçues : 735
Inscrit le : 13 octobre 2014
Version d'Excel : 2013 FR
Téléchargements : Mes applications

Message par Steelson » 4 novembre 2016, 04:18

claude.dasilva a écrit : .Range("B8").Copy Destination:=principal.Sheets(1).[a65536].End(xlUp).Offset(1)
.Range("D8").Copy Destination:=principal.Sheets(1).[a65536].End(xlUp).Offset(1)
...
En effet, à chaque fois tu passes à la ligne suivante puisque la case étant remplie il va chercher la suivante en colonne !!

Il faut
- figer la ligne au début
ligne = principal.Sheets(1).[a65536].End(xlUp).row
- utiliser cette ligne comme destination
.Range("B8").Copy Destination:=principal.Sheets(1).Cells(ligne,1)
.Range("D8").Copy Destination:=principal.Sheets(1).Cells(ligne,2)

O.o°• ♪♪♫ °º¤ø,¸¸,ø¤º°`°º¤ø,¸ O.o°• ♪♪♫ °º¤ø,¸¸,ø¤º°`°º¤ø,¸
PI = 3.14159 26535 89793 23846 26433 83279 50288 41971 69399 37510 58209 74944 59230 78164 06286 20899 86280

( ͡• ͜ʖ ͡• )
M
MFerrand
Fanatique d'Excel
Fanatique d'Excel
Messages : 17'201
Appréciations reçues : 445
Inscrit le : 20 juillet 2015
Version d'Excel : 2010 FR

Message par MFerrand » 4 novembre 2016, 07:10

Bonjour,
Bonjour Steelson,

Un petit aménagement pour le transfert des données...
Sub importDonnees()
    Dim wsC As Worksheet, Dai(9), adrS, n As Integer, i As Integer
    Dim repertoire As String, fichier As String
    Set wsC = ThisWorkbook.Worksheets(1)
    n = wsC.Cells(Rows.Count, 1).End(xlUp).Row
    adrS = Split("B8 D8 B11 B13 B15 C15 G15 C19 A28 A42")
    repertoire = ThisWorkbook.Path
    ChDir repertoire
    fichier = Dir("*.xlsm")
    Application.ScreenUpdating = False
    Do While fichier <> ""
        If fichier <> ThisWorkbook.Name Then
            Workbooks.Open fichier
            On Error GoTo suivant
            With ActiveWorkbook.Worksheets("FEM")
                On Error GoTo 0
                For i = 0 To 9
                    Dai(i) = .Range(adrS(i))
                Next i
                n = n + 1: wsC.Cells(n, 1).Resize(, 10) = Dai
            End With
            ActiveWorkbook.Close False
        End If
suivant:
        If Err.Number = 9 Then
            MsgBox "Pas de feuille ""FEM"" dans le fichier " & fichier, vbExclamation
            ActiveWorkbook.Close False
        End If
        fichier = Dir
    Loop
End Sub
Cordialement.
Avatar du membre
Steelson
Fanatique d'Excel
Fanatique d'Excel
Messages : 13'206
Appréciations reçues : 735
Inscrit le : 13 octobre 2014
Version d'Excel : 2013 FR
Téléchargements : Mes applications

Message par Steelson » 4 novembre 2016, 08:31

Salut MFerrand
adrS = Split("B8 D8 B11 B13 B15 C15 G15 C19 A28 A42")
joli, très pro, bien vu

O.o°• ♪♪♫ °º¤ø,¸¸,ø¤º°`°º¤ø,¸ O.o°• ♪♪♫ °º¤ø,¸¸,ø¤º°`°º¤ø,¸
PI = 3.14159 26535 89793 23846 26433 83279 50288 41971 69399 37510 58209 74944 59230 78164 06286 20899 86280

( ͡• ͜ʖ ͡• )
c
claude.dasilva
Nouveau venu
Nouveau venu
Messages : 5
Inscrit le : 3 novembre 2016
Version d'Excel : 2010

Message par claude.dasilva » 4 novembre 2016, 08:55

Bonjour,

Merci à vous deux...
J'avais fini par trouver une solution à mon problème en mettant ce code :
                .Range("B8").Copy Destination:=principal.Sheets(1).Range("A" & principal.Sheets(1).Range("A65536").End(xlUp).Row + 1)
                .Range("D8").Copy Destination:=principal.Sheets(1).Range("B" & principal.Sheets(1).Range("B65536").End(xlUp).Row + 1)
                .Range("B11").Copy Destination:=principal.Sheets(1).Range("C" & principal.Sheets(1).Range("C65536").End(xlUp).Row + 1)
                .Range("B13").Copy Destination:=principal.Sheets(1).Range("D" & principal.Sheets(1).Range("D65536").End(xlUp).Row + 1)
                .Range("B15").Copy Destination:=principal.Sheets(1).Range("E" & principal.Sheets(1).Range("E65536").End(xlUp).Row + 1)
                .Range("C15").Copy Destination:=principal.Sheets(1).Range("F" & principal.Sheets(1).Range("F65536").End(xlUp).Row + 1)
                .Range("G15").Copy Destination:=principal.Sheets(1).Range("G" & principal.Sheets(1).Range("G65536").End(xlUp).Row + 1)
                .Range("C19").Copy Destination:=principal.Sheets(1).Range("H" & principal.Sheets(1).Range("H65536").End(xlUp).Row + 1)
                .Range("A28").Copy Destination:=principal.Sheets(1).Range("I" & principal.Sheets(1).Range("I65536").End(xlUp).Row + 1)
                .Range("A42").Copy Destination:=principal.Sheets(1).Range("J" & principal.Sheets(1).Range("J65536").End(xlUp).Row + 1)
                .Range("K" & .Range("K65536").End(xlUp).Row) = Left(fichier, Len(fichier) - 4)
Mais beaucoup moins efficace que le votre !

Par contre je n'arrive pas à faire fonctionner la ligne :
.Range("K" & .Range("K65536").End(xlUp).Row) = Left(fichier, Len(fichier) - 4)
Le but étant de savoir à quel fichier est associé chaque ligne.
Pouvez-vous m'aider à l'intégrer à votre code svp ?

Merci.
c
claude.dasilva
Nouveau venu
Nouveau venu
Messages : 5
Inscrit le : 3 novembre 2016
Version d'Excel : 2010

Message par claude.dasilva » 27 novembre 2016, 12:14

Bonjour,

Petit retour sur mon message précédent.
Quelqu'un peut-il m'aider sur ma dernière question ?
Je voudrais pour chaque ligne que le nom du fichier d'origine soit associé à la ligne.
La ligne n° 45 par exemple, sur la colonne A, qu'il m'affiche le nom du fichier "243.xls".
Merci de votre aide.
Le fichier fonctionne très bien grâce à votre aide, il ne manque que cette dernière option pour faciliter les recherches en cas de doute.

Cordialement.
M
MFerrand
Fanatique d'Excel
Fanatique d'Excel
Messages : 17'201
Appréciations reçues : 445
Inscrit le : 20 juillet 2015
Version d'Excel : 2010 FR

Message par MFerrand » 27 novembre 2016, 13:52

Bonjour,

Si je comprends bien, c'est une colonne supplémentaire pour ajouter le nom du fichier.

Par rapport à la procédure que j'ai proposée, il faut alors déclarer ; Dai(10) [au lieu de Dai(9)]

Puis dans le corps de la procédure (ajout ou modification surligné) :
                For i = 0 To 9
                    Dai(i) = .Range(adrS(i))
                Next i
                [surligner]Dai(10) = ActiveWorkbook.Name[/surligner]
                n = n + 1: wsC.Cells(n, 1).Resize(, [surligner]11[/surligner]) = Dai
ceci met le nom du fichier en colonne K.

Ou bien :
                For i = 0 To 9
                    Dai([surligner]i + 1[/surligner]) = .Range(adrS(i))
                Next i
                [surligner]Dai(0) = ActiveWorkbook.Name[/surligner]
                n = n + 1: wsC.Cells(n, 1).Resize(, [surligner]11[/surligner]) = Dai
ceci met le nom du fichier en colonne A.

Cordialement.
c
claude.dasilva
Nouveau venu
Nouveau venu
Messages : 5
Inscrit le : 3 novembre 2016
Version d'Excel : 2010

Message par claude.dasilva » 27 novembre 2016, 14:00

Merci M. Ferrand
J'essaie demain et je vous tiens au courant...
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message