XL 2016 Importer les données de plusieurs fichiers Excel portant le même nom dans un nouveau fichier

Dadi147 · 12 Janvier 2023

Bonjour. Renseignements pour ceux qui ont de l'expérience. J'ai 7 fichiers Excel avec le même nom, (summary).ils ont été placés dans 7 dossiers dans un dossier, et je veux un moyen de les copier dans un nouveau fichier en dessous l'un de l'autre. Pouvons-nous faire cela

job75 · 14 Janvier 2023

Bonjour Dadi147, le forum,

L'importation se fait très simplement avec cette macro :

VB:

Sub Importer()
Dim chemin$, dossier, fichier, F As Worksheet, lig&, i%, h&
chemin = ThisWorkbook.Path & "\"
dossier = Array("Dossier1", "Dossier2", "Dossier3", "Dossier4", "Dossier5", "Dossier6", "Dossier7") 'liste à adapter
fichier = "Summary.xls" 'à adapter
Set F = ActiveSheet
lig = 2 '1ère ligne de destination
Application.ScreenUpdating = False
F.Rows(lig & ":" & F.Rows.Count).Delete 'RAZ
For i = 0 To UBound(dossier)
    With Workbooks.Open(chemin & dossier(i) & "\" & fichier).Sheets(1) 'ouverture du fichier
        If .FilterMode Then .ShowAllData 'si la feuille est filtrée
        h = .Range("B" & .Rows.Count).End(xlUp).Row 'dernière ligne en...

Compte Supprimé 979 · 12 Janvier 2023

Bonjour Dadi147

Est-ce que vous vous êtes relu après avoir écrit

Tant mieux si vous vous comprenez

Dadi147 · 12 Janvier 2023

BrunoM45 à dit:
Bonjour Dadi147

Est-ce que vous vous êtes relu après avoir écrit

Tant mieux si vous vous comprenez

L'idée est que j'ai plusieurs copies du même fichier avec le même nom, mais avec des données différentes. Je veux les fusionner en un nouveau fichier

Hasco · 12 Janvier 2023

Bonjour
Et dire bonjour c'est un prix exorbitant pour vous ?

cp4 · 12 Janvier 2023

Hasco à dit:
Bonjour
Et dire bonjour c'est un prix exorbitant pour vous ?

Bonjour @Hasco , @BrunoM45

,

Je ne fais que copier. Donc, je dis bonjour qu'aux personnes polies.
David devrait instaurer des sanctions envers ceux et celles qui dérogent aux règles du forum.

Bonne journée.

Dadi147 · 12 Janvier 2023

cp4 à dit:
Bonjour @Hasco , @BrunoM45 ,

Je ne fais que copier. Donc, je dis bonjour qu'aux personnes polies.
David devrait instaurer des sanctions envers ceux et celles qui dérogent aux règles du forum.

Bonne journée.

Il y a un malentendu, je n'ai juste pas fait attention et j'ai écrit un mot (bienvenue)
je ne savais pas qu'il y avait une différence
Il a été modifié dans le post, désolé encore......

kiki29 · 12 Janvier 2023

Salut, de l'archéologie informatique (2014), perfectible sans doute, à toi de le tester/modifier/adapter à ton contexte.

Dadi147 · 12 Janvier 2023

kiki29 à dit:
Salut, de l'archéologie informatique, perfectible sans doute, à toi de le tester/modifier/adapter à ton contexte.

Bonjour. Tout d'abord, merci de l'intérêt que vous portez à ma demande... Vous a-t-il vraiment été possible de faire ce qui m'était impossible ??? Je reviendrai après avoir essayé le fichier

Dadi147 · 12 Janvier 2023

kiki29 à dit:
Salut, de l'archéologie informatique (2014), perfectible sans doute, à toi de le tester/modifier/adapter à ton contexte.

Pouvez-vous expliquer comment ajouter des fichiers

Dadi147 · 12 Janvier 2023

kiki29 à dit:
Salut, de l'archéologie informatique (2014), perfectible sans doute, à toi de le tester/modifier/adapter à ton contexte.

Dadi147 · 12 Janvier 2023

Bonjour. Très, très, très beau. Il me manque un ajout simple, à savoir que j'ai des espaces entre les lignes de la colonne A. J'ai essayé de modifier le code, mais je n'ai pas réussi. Pouvez-vous m'aider ?

Dadi147 · 12 Janvier 2023

kiki29 à dit:
Re, n'étant pas doté de boule de cristal, un échantillon anonymisé d'un fichier serait souhaitable.

Tous les fichiers sont comme ceci

kiki29 · 13 Janvier 2023

Re,
Dans la procédure FusionFichiers, ajouter :

VB:

.Range("A3:A" & Rows.Count).Delete Shift:=xlToLeft

ici

Code:

.....
With WkbDecoupage.Worksheets(sFeuille)
                    If FeuilleVide(WkbDecoupage.Worksheets(sFeuille)) = False Then
            >>>>>>      .Range("A3:A" & Rows.Count).Delete Shift:=xlToLeft
                        iLastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
                        .....

Dadi147 · 13 Janvier 2023

kiki29 à dit:

Re,
Dans la procédure FusionFichiers, ajouter :

VB:

.Range("A3:A" & Rows.Count).Delete Shift:=xlToLeft

ici

Code:

.....
With WkbDecoupage.Worksheets(sFeuille)
                    If FeuilleVide(WkbDecoupage.Worksheets(sFeuille)) = False Then
            >>>>>>      .Range("A3:A" & Rows.Count).Delete Shift:=xlToLeft
                        iLastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
                        .....

Lorsque vous essayez d'ouvrir le fichier sur un ordinateur 64 bits, ce message est apparu

VB:

Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function FindFirstFile Lib "kernel32" _
                                       Alias "FindFirstFileA" _
                                       (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" _
                                      Alias "FindNextFileA" _
                                      (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As Long) As Long
Private Declare Function PathMatchSpec Lib "shlwapi" _
                                       Alias "PathMatchSpecW" _
                                       (ByVal pszFileParam As Long, ByVal pszSpec As Long) As Long

kiki29 · 13 Janvier 2023

Re, à lire/appliquer : Développer avec Office 64 bits sinon supprimer la partie APIs et la remplacer par FSO

XL 2016 Importer les données de plusieurs fichiers Excel portant le même nom dans un nouveau fichier

Dadi147

XLDnaute Occasionnel

job75

Compte Supprimé 979

Guest

Dadi147

XLDnaute Occasionnel

Hasco

XLDnaute Barbatruc

cp4

XLDnaute Barbatruc

Dadi147

XLDnaute Occasionnel

kiki29

XLDnaute Barbatruc

Pièces jointes

Dadi147

XLDnaute Occasionnel

Dadi147

XLDnaute Occasionnel

Dadi147

XLDnaute Occasionnel

Pièces jointes

Dadi147

XLDnaute Occasionnel

Dadi147

XLDnaute Occasionnel

Pièces jointes

kiki29

XLDnaute Barbatruc

Pièces jointes

Dadi147

XLDnaute Occasionnel

Pièces jointes

kiki29

XLDnaute Barbatruc

Discussions similaires