Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel regroupement de plusieurs fichiers

regroupement de plusieurs fichiers

24 réponses
Avatar
clyver
Bonjour le forum d'entraide,

J'ai un besoin de regroupement de plusieurs fichiers:

Sur un regroupements d'une dizaine de fichiers que je veux cibl=E9 dans
des r=E9pertoires d=E9fini sachant que dans ces r=E9pertoires j'ai d'autre
fichiers que je ne veux pas requ=EAter.

exemple mais fichiers se trouve dans :
S:\Suivis\FaD\384x298 LTW\384x298 LTW CANTO.xls
S:\Suivis\FaD\520x612 MW\520x612 MW-CH111.xls
S:\Suivis\FaD\MIPOD\MIPOD-CH286A.xls

PS : tous les fichiers on, une feuille nomm=E9e (FAD)
avec en titre colonne A =3D> ann=E9e, en B =3D> mois, en C =3D> n=B0 de la
semaine


Le besoin serait de regrouper tout les fichiers par rapport =E0 l'ann=E9e
et le N=B0 de semaine.
http://cjoint.com/?jpszQoi3OX

cordialament

Franck
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2 3
Avatar
michdenis
| 1/ Quand j'active la macro "regroup" certaine de mes classeur on des
| liens peux ton lui dire de pas faire de mise à jour lors de la copie
| qui se noterai dans la colonne K?
****si tu prends le temps de lire l'aide de la méthode "Open" de
l'objet Workbooks, tu verras ceci :

-------------------------------------------------
expression.Open(FileName, MettreÀJourLiens, LectureSeule, Format, MotDePasse,
MotDePasseÉcritureRes, IgnorerLectureSeuleRecommandée, Origine, Séparateur, Modifiable,
Notifier, Convertisseur, AjouterAuxDerniersFichiersUtilisés, Local, ChargementEndommagé)
--------------------------------------------------

Je suppose que si tu écris ceci :
Workbooks.Open Chemin & Classeur, False
ça devrait le faire, qu'en penses-tu ?

| 2/ Est-il possible de noter a coté de chaque ligne l'emplacement du
| fichier trouvé? (comme mon exemple du 1er poste)
'------------------------------------------------
Essaie ceci :
Sub regroup()
Dim Elt As Variant,Lig As Long
Dim Arr(1 To 3), Sh As Worksheet, Wk As Workbook

Arr(1) = "S:SuivisFaD384x298 LTW384x298 LTW CANTO.xls"
Arr(2) = "S:SuivisFaD520x612 MW520x612 MW-CH111.xls"
Arr(3) = "S:SuivisFaDMIPODMIPOD-CH286A.xls "

Set Sh = ThisWorkbook.Worksheets("Feuil1")
Application.ScreenUpdating = False
For Each Elt In Arr
If Dir(Elt) <> "" Then
Set Wk = Workbooks.Open(Elt)
With Wk
With .Worksheets("FAD")
Lig = .Range("C65536").End(xlUp).Row
.Range("C5", .[C65536].End(xlUp).Address).Copy _
Destination:=Sh.Range("I" & _
Sh.Range("i65536").End(xlUp)(2).Row).Resize(Lig - 5)
Sh.Range("I5").Resize(Lig - 5).Value = Elt
End With
.Close False
End With
Else
MsgBox "Pas trouver ce fichier : " & vbCrLf & Elt
End If
Next
Application.ScreenUpdating = True
End Sub
'------------------------------------------------



| 3/ J'aimerai également mettre à jour ma macro à l'ouverture du fichier
| (ouverture du classeur regroup actualiser les données)

*** Dans le ThisWorkbook de ton projet VBA, utilise ceci :
'---------------------------------------
Private Sub Workbook_Open()
regroup
End Sub
'---------------------------------------
Avatar
clyver
re BONSOIR?


J'ai un problème avec
Lig = .Range("C65536").End(xlUp).Row
.Range("C5", .[C65536].End(xlUp).Address).Copy _
Destination:=Sh.Range("I" & _
Sh.Range("i65536").End(xlUp)(2).Row).Resize(Lig - 5)
Sh.Range("I5").Resize(Lig - 5).Value = Elt

ça bug j'aimerai comprendre de plus impossible d'ajouter [, False]
[Set Wk = Workbooks.Open(Elt) ]

merci
Avatar
michdenis
| ça bug j'aimerai comprendre de plus impossible d'ajouter [, False]
| [Set Wk = Workbooks.Open(Elt) ]

**** La ligne de code est celle-ci :
Set Wk = Workbooks.Open(Elt,True)


J'ai un problème avec:

**** D'abord, as-tu vérifié que la référence les adresses faisaient
référence au bonne colonnes de ton application ?
**** Laquelle des lignes est fautive ?
'----------------------------------------------
Lig = .Range("C65536").End(xlUp).Row
.Range("C5", .[C65536].End(xlUp).Address).Copy _
Destination:=Sh.Range("I" & _
Sh.Range("i65536").End(xlUp)(2).Row).Resize(Lig - 5)
Sh.Range("I5").Resize(Lig - 5).Value = Elt
'----------------------------------------------
Avatar
clyver
Bonjour,

mes classeurs que je veux copier se trouve tous en zone (A2:I65536)
puis la destination est idem sur mon classeur (A2:I65536)
puis l'insération du nom du fichier source se fait dans (K2:K65536)

y-a-t'il un outil pour comprendre ceci :
'----------------------------------------------
Lig = .Range("C65536").End(xlUp).Row
.Range("C5", .[C65536].End(xlUp).Address).Copy _
       Destination:=Sh.Range("I" & _
        Sh.Range("i65536").End(xlUp)(2).Row).Resize(Lig - 5)
         Sh.Range("I5").Resize(Lig - 5).Value = Elt
'----------------------------------------------


Avatar
michdenis
Quelque chose comme ceci :

'------------------------------------------
Sub regroup()
Dim Elt As Variant, Lig As Long, DerLig As Long
Dim Arr(1 To 3), Sh As Worksheet, Wk As Workbook

Arr(1) = "S:SuivisFaD384x298 LTW384x298 LTW CANTO.xls"
Arr(2) = "S:SuivisFaD520x612 MW520x612 MW-CH111.xls"
Arr(3) = "S:SuivisFaDMIPODMIPOD-CH286A.xls "

'Où les données seront copiées : Nom Feuille à adapter
Set Sh = ThisWorkbook.Worksheets("Feuil1")

Application.ScreenUpdating = False
For Each Elt In Arr
If Dir(Elt) <> "" Then
Set Wk = Workbooks.Open(Elt)
With Wk
With .Worksheets("FAD")
'Dernière ligne de la feuille à copier
Lig = .Range("A:I").Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
'Dernière ligne occupée de la feuille de destination
DerLig = Sh.Range("A:I").Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
'Copie des données
.Range("A2:I" & DerLig).Copy Sh.Range("A" & Lig + 1)
'Sur chaque ligne copiée, indique le chemin + Nom Fichier
Sh.Range("K" & Lig + 1).Resize(DerLig - 1) = Elt
End With
'Fermeture du classeur
.Close False
End With
Else
MsgBox "Pas trouver ce fichier : " & vbCrLf & Elt
End If
Next
Application.ScreenUpdating = True
End Sub
'------------------------------------------



"clyver" a écrit dans le message de groupe de discussion :

Bonjour,

mes classeurs que je veux copier se trouve tous en zone (A2:I65536)
puis la destination est idem sur mon classeur (A2:I65536)
puis l'insération du nom du fichier source se fait dans (K2:K65536)

y-a-t'il un outil pour comprendre ceci :
'----------------------------------------------
Lig = .Range("C65536").End(xlUp).Row
.Range("C5", .[C65536].End(xlUp).Address).Copy _
Destination:=Sh.Range("I" & _
Sh.Range("i65536").End(xlUp)(2).Row).Resize(Lig - 5)
Sh.Range("I5").Resize(Lig - 5).Value = Elt
'----------------------------------------------


Avatar
clyver
Re Bonsoir,

alors la je suis a coté t'as macro ne fonctionne pas du tout chez moi

ça me copie sept ligne puis le nom des fichiers sur 700 lignes je
comprend plus du tout le 1er code est plus simple mais difficile a
comprendre les lignes
'----------------------------------------------
Lig = .Range("C65536").End(xlUp).Row
.Range("C5", .[C65536].End(xlUp).Address).Copy _
Destination:=Sh.Range("I" & _
Sh.Range("i65536").End(xlUp)(2).Row).Resize(Lig - 5)
Sh.Range("I5").Resize(Lig - 5).Value = Elt
'----------------------------------------------

car la je suis a coté...
Avatar
Mgr.Abile
Bonsoir,
Et pourtant, c'est dans des tas de macros que Denis a choisi celle qu'il t'a
envoyé...
;o))
--
News://news.microsoft.com/microsoft.public.fr.excel
Allez en paix
T.Abile
"clyver" a écrit dans le message de
news:
Re Bonsoir,

alors la je suis a coté t'as macro ne fonctionne pas du tout chez moi
[...]
Avatar
michdenis
Les explications de chaque ligne de la macro :

P.S- Si la feuille où tu copies les données est une feuille
vierge, une erreur sera générée.

Tu devrais pouvoir t'en tirer avec ça !

'---------------------------------------------------------------
Sub regroup()
'Déclaration des variables
Dim Elt As Variant, Lig As Long, DerLig As Long
Dim Arr(1 To 3), F As Worksheet, Wk As Workbook

'Chemin des fichiers et nom des fichiers à traiter
Arr(1) = "S:SuivisFaD384x298 LTW384x298 LTW CANTO.xls"
Arr(2) = "S:SuivisFaD520x612 MW520x612 MW-CH111.xls"
Arr(3) = "S:SuivisFaDMIPODMIPOD-CH286A.xls "

'Où les données seront copiées dans une
'feuille du classeur où est la macro
'Nom Feuille à adapter :Feuil1

Set F = ThisWorkbook.Worksheets("Feuil1")
'F.Name = "Résultat"

'Éviter le rafraîchissement de l'écran durant
'la procédure.
Application.ScreenUpdating = False

On Error Resume Next
'pour chacun des classeurs dans le tableau Arr()
For Each Elt In Arr
'Test pour savoir si le fichier existe
If Dir(Elt) <> "" Then
'Ouverture du fichier
Set Wk = Workbooks.Open(Elt)
'Avec le fichier que l'on vient d'ouvrir
With Wk
'Avec la feuille FAD du classeur
With .Worksheets(FAD)
'Dernière ligne occupée de la feuille
'à copier dans les colonnes A:I
Lig = .Range("A:I").Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row

'Dernière ligne occupée de la feuille
'de destination dans le classeur
'où est la macro dans les colonnes A:I
DerLig = F.Range("A:I").Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
If Err <>0 Then
Err = 0
DerLig = 1
End IF

'Copie des données de la Feuille FAD vers
'la feuille F(feuille de destination)
'DerLig + 1 -> la ligne suivante à la
'dernière occupée
.Range("A2:I" & Lig).Copy F.Range("A" & DerLig + 1)

'Pour chaque ligne copiée,indique dans la colonne K
'le chemin + Nom Fichier
F.Range("K" & DerLig + 1).Resize(Lig - 1) = Elt
End With
'Fermeture du classeur
.Close False
End With
Else
'Message si le fichier n'est pas trouvé.
MsgBox "Pas trouver ce fichier : " & vbCrLf & Elt
End If
Next
Application.ScreenUpdating = True
End Sub
'---------------------------------------------------------------
Avatar
LSteph
Bonjour,

Pas parlé d'obligation mais d'une précaution qui m'a déjà tiré
d'affaire.
sauf que si on se contente d'appliquer plus simplement ce que j'ai
suggèré,
mettre ces fichiers et pas d'autres dans un rep dévolu à cette
opération le pb n'existe même pas
on se contremoque du nom de fichier et c'est comme cela que je procède
sans risque de mal orthographier.
Maintenant, il me semble que Clyver ne veut résolument pas entendre
ce que je disais ou ne souhaite pas procèder ainsi et ta suggestion
est dans l'alternative meilleure que ce que j'avais proposé,

voilà pourquoi je dis
| certes ce sera un bien meilleur compromis!



Cordialement.

--
lSteph


On 18 sep, 15:26, "michdenis" wrote:
| mais avec mêmes réserves:  ne pas se planter dans le libellé.
| Utiliser quotes pour les 'nom de fichiers' qui ont des espaces

J'ai fait ce test :
Workbooks.Open "c:usersDMDocumentsLe Testle classeur2.xls"

et le fichier s'ouvre normalement. Où vois-tu l'obligation de mettre de s "quotes" ?

On 18 sep, 12:59, "michdenis" wrote:



> Il peut aussi boucler sur une plage de cellule où
> il aura insérer le chemin et l'adresse de chaque fichier
> à traiter !
> ;-)

> "LSteph" a écrit dans le message de groupe de di scussion :
>
> Bonjour,

> C'est pas pour rien que j'ai précisé>crée un répertoire dans le quel tu copies
> exclusivement ces fichiers

> et a fortiiori puisqu'ils ne sont pas dans le même
> les copier  dans un rep devolu à cet effet et uniquement ceux là tu
> iras plus vite
> car sinon tu devras  puisqu'ils ne sont pas dans le même
> soit traiter les différents chemins  répertoires
> .. 384x298 LTW ..
> ...520x612 MW...
> ...
> puis distinguer dans un Select Case les noms de fichiers

> soit aller écrire en dur tous les noms des fichiers que tu dois
> traiter consécutivement dans le code .

> C'est bien plus lourd et plus long!

> Sinon aulieu de passer par du code tu mets une feuille pour chacun de
> ces claseurs  liée à ce que tu veux dedans.

> Cordialement.

> --
> lSteph

> On 17 sep, 07:03, clyver wrote:

> > Bonjour et merci à vous pour les deux propositions,

> > Par contre j'ai un pb car sur cette demande mes répertoires sont
> > classé dans des répertoires avec d'autres fichiers que je ne veux pas
> > filtrer.

> > S:SuivisFaD384x298 LTW384x298 LTW CANTO.xls
> > S:SuivisFaD520x612 MW520x612 MW-CH111.xls
> > S:SuivisFaDMIPODMIPOD-CH286A.xls

> > exemple dans le 1er liens il y a 6 classeurs excel je veux voir que l e
> > "384x298 LTW CANTO.xls"

> > merci- Masquer le texte des messages précédents -

> - Afficher le texte des messages précédents -- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -


Avatar
clyver
Merci des précisions, mais sur cette dernière macro regroup2 j'ai
riens qui se copie dans ma feuille1?

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ ¤¤¤¤¤¤¤
Sub regroup2()
'Déclaration des variables
Dim Elt As Variant, Lig As Long, DerLig As Long
Dim Arr(1 To 3), F As Worksheet, Wk As Workbook

'Chemin des fichiers et nom des fichiers à traiter
Arr(1) = "S:SuivisFaD384x298 LTW384x298 LTW CANTO.xls"
Arr(2) = "S:SuivisFaD520x612 MW520x612 MW-CH111.xls"
Arr(3) = "S:SuivisFaDMIPODMIPOD-CH286A.xls "

'Où les données seront copiées dans une
'feuille du classeur où est la macro
'Nom Feuille à adapter :Feuil1

Set F = ThisWorkbook.Worksheets("Feuil1")
'F.Name = "Résultat"

'Éviter le rafraîchissement de l'écran durant
'la procédure.
Application.ScreenUpdating = False

On Error Resume Next
'pour chacun des classeurs dans le tableau Arr()
For Each Elt In Arr
'Test pour savoir si le fichier existe
If Dir(Elt) <> "" Then
'Ouverture du fichier
Set Wk = Workbooks.Open(Elt)
'Avec le fichier que l'on vient d'ouvrir
With Wk
'Avec la feuille FAD du classeur
With .Worksheets(FAD)
'Dernière ligne occupée de la feuille
'à copier dans les colonnes A:I
Lig = .Range("A:I").Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row

'Dernière ligne occupée de la feuille
'de destination dans le classeur
'où est la macro dans les colonnes A:I
DerLig = F.Range("A:I").Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
If Err <>0 Then
Err = 0
DerLig = 1
End IF

'Copie des données de la Feuille FAD vers
'la feuille F(feuille de destination)
'DerLig + 1 -> la ligne suivante à la
'dernière occupée
.Range("A2:I" & Lig).Copy F.Range("A" & DerLig + 1)

'Pour chaque ligne copiée,indique dans la colonne K
'le chemin + Nom Fichier
F.Range("K" & DerLig + 1).Resize(Lig - 1) = Elt
End With
'Fermeture du classeur
.Close False
End With
Else
'Message si le fichier n'est pas trouvé.
MsgBox "Pas trouver ce fichier : " & vbCrLf & Elt
End If
Next
Application.ScreenUpdating = True
End Sub
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ ¤¤¤¤¤¤¤

PS pour le moment la seul marco qui fonctionne mais sans lien des
fichiers

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ ¤¤¤¤¤¤¤
Sub regroup()
Dim Elt As Variant, Lig As Long, DerLig As Long
Dim Arr(1 To 3), Sh As Worksheet, Wk As Workbook

Arr(1) = "S:SuivisFaD384x298 LTW384x298 LTW CANTO.xls"
Arr(2) = "S:SuivisFaD520x612 MW520x612 MW-CH111.xls"
Arr(3) = "S:SuivisFaDMIPODMIPOD-CH286A.xls "


Set Sh = ThisWorkbook.Worksheets("Feuil1")
Application.ScreenUpdating = False
For Each Elt In Arr
If Dir(Elt) <> "" Then
Set Wk = Workbooks.Open(Elt)
With Wk
With .Worksheets("FAD")

Lig = .Range("A65536").End(xlUp).Row
.Range("I2", .[A65536].End(xlUp).Address).Copy _
Destination:=Sh.Range("A" & _
Sh.Range("i65536").End(xlUp)(2).Row).Resize(Lig - 1)

End With
.Close False
End With
Else
MsgBox "Pas trouver ce fichier : " & vbCrLf & Elt
End If
Next
Application.ScreenUpdating = True
End Sub
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ ¤¤¤¤¤¤¤
1 2 3