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
Je t'ai écrit une procédure, j'ai commenté chacune des lignes de la procédure. Moi, j'appelle ça de l'aide... non ?
À ton tour, si tu n'obtiens pas le résultat escompté, il faudrait peut être que tu commentes un peu ce qui ne fonctionne pas... ce que tu obtiens au lieu de te contenter d'un : "ça marche pas!".
As-tu pris le temps, d'adapter le nom des objets où c'est indiqué dans la procédure ?
'-------------------------------------------------- Sub regroup() Dim Elt As Variant, Lig As Long, DerLig As Long Dim Arr(1 To 3), Sh As Worksheet, Wk As Workbook
'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 '--------------------------------------------------
| Personne ne peux m'aider?
Je t'ai écrit une procédure,
j'ai commenté chacune des lignes de la procédure.
Moi, j'appelle ça de l'aide... non ?
À ton tour, si tu n'obtiens pas le résultat escompté,
il faudrait peut être que tu commentes un peu ce qui
ne fonctionne pas... ce que tu obtiens au lieu de te
contenter d'un : "ça marche pas!".
As-tu pris le temps, d'adapter le nom des objets
où c'est indiqué dans la procédure ?
'--------------------------------------------------
Sub regroup()
Dim Elt As Variant, Lig As Long, DerLig As Long
Dim Arr(1 To 3), Sh As Worksheet, Wk As Workbook
'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
'--------------------------------------------------
Je t'ai écrit une procédure, j'ai commenté chacune des lignes de la procédure. Moi, j'appelle ça de l'aide... non ?
À ton tour, si tu n'obtiens pas le résultat escompté, il faudrait peut être que tu commentes un peu ce qui ne fonctionne pas... ce que tu obtiens au lieu de te contenter d'un : "ça marche pas!".
As-tu pris le temps, d'adapter le nom des objets où c'est indiqué dans la procédure ?
'-------------------------------------------------- Sub regroup() Dim Elt As Variant, Lig As Long, DerLig As Long Dim Arr(1 To 3), Sh As Worksheet, Wk As Workbook
'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
Bonjour au forum
Je viens de trouver le pb
ligne : erreur sur les "" => With .Worksheets(FAD)
With .Worksheets("FAD")
Encore merci de votre entraide.
Bonjour au forum
Je viens de trouver le pb
ligne :
erreur sur les "" => With .Worksheets(FAD)
ligne : erreur sur les "" => With .Worksheets(FAD)
With .Worksheets("FAD")
Encore merci de votre entraide.
michdenis
Merci du retour.
| erreur sur les "" => With .Worksheets(FAD) **** Pourtant dans la procédure que je t'ai transmise les guillemets y étaient !
"clyver" a écrit dans le message de groupe de discussion :
Bonjour au forum
Je viens de trouver le pb
ligne : erreur sur les "" => With .Worksheets(FAD)
With .Worksheets("FAD")
Encore merci de votre entraide.
Merci du retour.
| erreur sur les "" => With .Worksheets(FAD)
**** Pourtant dans la procédure que je t'ai transmise
les guillemets y étaient !
"clyver" <clyver@msn.com> a écrit dans le message de groupe de discussion :
cad0052d-0a0c-469e-8491-64a4138bbda8@p9g2000vbl.googlegroups.com...
Bonjour au forum
Je viens de trouver le pb
ligne :
erreur sur les "" => With .Worksheets(FAD)
