Sélection Plage de feuille de Chaque Fichier dans un Dossier
Bonjour forum,
C'est formidable de me sentir progresser grâce à vos différents éclairages de part et d'autres. J'ai un petit problème.
J'ai un dossier qui contient des fichiers. Chaque fichier a un nom entier (type aaaamm).
- Chaque fichier de ce dossier contient des feuilles, dont une porte seule le même nom que le fichier qui la contient.
- Dans cette feuille qui porte le nom du fichier, j'ai une plage de données intitulée: le mois mm en Lettres de la feuille (nommée aaaamm).
Mon but, selectionner la plage mm de chaque fichier contenu dans le dossier initial dont j'ai donné le chemin au depart. Ci-dessous, ma proposition de code:
Public Sub Matrice()
Dim Fichier As Variant, FichierDest As Variant
Dim FichierCible As String, cible As String, Chemin As String
Dim PlageTraitee As Range
Dim FeuilleDest As Worksheet, sheet As Worksheet, FeuilleP As Worksheet
Dim i As Integer, Decalage As Integer
cible = "ADD"
FichierCible = "Projet"
Set FeuilleDest = Workbooks(FichierCible).Worksheets(cible)
Decalage = 1
'Définit le répertoire contenant les fichiers
Chemin = "C:\users\Pop\desktop\Extrations\HistoDODI\"
Fichier = Dir(Chemin & "*.*", vbNormal)
'Fichier = Dir(Chemin & "*.*")
Dim d As String, c As String, f As String
Do While Len(Fichier) > 0
c = Left(Fichier, Len(Fichier) - 5)
With Workbooks(c)
For Each sheet In Worksheets
Set FeuilleP = sheet
d = NomPlage(Right(c, 2))
Set PlageTraitee = FeuilleP.Range(d)
FeuilleDest.Range(Decalage & ":" & (Decalage + PlageTraitee.Rows.Count + 2)).Insert shift:=xlDown
PlageTraitee.Copy
FeuilleDest.Range("A" & Decalage + 1).Value = FeuilleP.Name
FeuilleDest.Range("A" & Decalage + 2).PasteSpecial Transpose:=True
Next sheet
End With
Fichier = Dir(, vbNormal)
Loop
Dim plage As Range
Set plage = Workbooks(FichierCible).Sheets(cible).Range("A1").End(xlDown)
Supprimer plage
End Sub
Public Sub Supprimer(plage As Range)
Dim c As Range
For Each c In plage
If c.Value = "FAUX" Then
c.EntireRow.Delete
End If
Next c
End Sub
Private Function NomPlage(a As Integer) As String
Dim res As String
If Right(a, 2) = 1 Then
res = "Janvier"
NomPlage = res
ElseIf Right(a, 2) = 2 Then
res = "Fevrier"
NomPlage = res
ElseIf Right(a, 2) = 3 Then
res = "Mars"
NomPlage = res
ElseIf Right(a, 2) = 4 Then
res = "Avril"
NomPlage = res
ElseIf Right(a, 2) = 5 Then
res = "Mai"
NomPlage = res
ElseIf Right(a, 2) = 6 Then
res = "Juin"
NomPlage = res
ElseIf Right(a, 2) = 7 Then
res = "Juillet"
NomPlage = res
ElseIf Right(a, 2) = 8 Then
res = "Aout"
NomPlage = res
ElseIf Right(a, 2) = 9 Then
res = "Septembre"
NomPlage = res
ElseIf Right(a, 2) = 10 Then
res = "Octobre"
NomPlage = res
ElseIf Right(a, 2) = 11 Then
res = "Novembre"
NomPlage = res
ElseIf Right(a, 2) = 12 Then
res = "Decembre"
NomPlage = res
Else: MsgBox "Vérifier le nom de Fichier DODI donné: " & a
End If
End Function
Merci d'avance de vos propositions.
Bonjour,
quel est le but ?
on peut lire les info d'une plage de cellules de classeurs fermés, mais on ne peut pas sélectionner ces plages puisque les classeurs sont fermés.
Bonjour,
Je cherche à faire un copier coller de données mensuelles résumées dans des fichiers différents d'un seul et même dossier.
On imagine pour modéliser, que je suis un prof principal d'école qui souhaite mettre dans un fichier final, des récapitulatifs de notes dans chaque matière de ses classes de Terminale depuis N années.
Notre prof a alors un dossier "classe de terminale S" dans lequel il y a des fichiers mensuels de notes (12 fichiers par an) depuis N années de toutes ses Terminales S. Dans chaque fichier, des onglets reprenant les matières de ses élèves. Notre prof s'intéresse dans un premier temps à sa matiere, les MATHS.
Il souhait alors regrouper dans un fichier final, les notes de ses classes de terminales depuis N ans, soit faire un copier-coller des 12N fichiers de son dossier. Il a pris soin de nommer chaque fichier en chiffre date "aaaamm" pour les ordonner automatiquement afin de faire un copier coller du plus ancien au plus récent.
Dans chaque fichier enfin, il s'arrange à donner à l'onglet MATHS le même nom que le fichier pour le cibler rapidement. Dans son onglet nommé désormais "aaaamm" comme le fichier, il définit sa plage correspondant au mois "mm" mais en lettres cette fois du nom de l'onglet (parce qu'un nom de plage ne peut être entier dans Excel apparemment).
Dans le fichier final, les plages sont copiées et collées par fichier, du plus anciens au plus récents par insertions de lignes correspondant au nombre d'élèves (donc de lignes) de la plage.
Pour aller plus loin....
A long terme, notre professeur principal des terminal voudra répéter cette expérience quelque soit la matière (l'onglet), afin de juger du niveau global moyen des élèves par matière et moyen global total de toutes les matières affectées de leurs coefficients.
Un peu long mais je l'espère, assez clair ?!.
Merci beaucoup.
Le code proposé (dans le for) fonctionne pour un fichier avec un :
For i=1 to workbook.worksheets.count
Mais bloque au niveau du with. Il m'affiche code 9: l'indice n'appartient pas à la sélection. Je ne vois pas trop pourquoi....
Bonjour,
Dans ta macro Matrice() ..
With Workbooks(c)
c est une variable que tu n'as pas définie ... et surtout ton With ... End With n'est pas du tout utilisé ...!!!
Bonjour Yeshua, James, à tous,
J'ai un dossier qui contient des fichiers
Yeshua , la question est: est ce que ces fichiers sont "fermés" ou " ouvert"
Bonjour SabV,
Le dossier et ses fichiers sont fermés. Fermés étant entendu comme on n'a double-cliqué dessus pour les ouvrir.
James,
Possible. C'est donc que je ne sais pas comment utiliser le With dans ce cas. With ne sert il pas à spécifier l'objet dans lequel on souhaite travailler?
Bien à vous,
Y
bonjour James,
La variable c reçoit le nom de chaque fichier. Puis avec l'instruction WITH je voulais spécifier au programme de faire le copier coller sur à partir du fichier nommé c. ( L'instruction appeler le fichier nommé C n'est peut pas workbooks(c) ?)
Que faire ici?
Bonjour,
Un exemple :
Sub Macro1()
With Selection.Font
.Color = 65535
.TintAndShade = 0
End With
End Sub
Tu remarqueras un point .Color .TintAndShade devant Color et devant TintAndShade .... ce sont ces points qui indiquent que tu n'as pas besoin de retaper Selection.Font à chaque ligne .....
Bonjour James,
Merci beaucoup. Je réalise que je n'avais pas compris l'utilisation de WITH... END WITH.
Comment donc indiquer avec un for each... next qu'on veut parcourir les feuilles d'un fichier donné (le nom du fichier étant dynamique) ?
Re,
Il existe beacoup de possibilités ... celle à laquelle tu fais référence ... la boucle For Each ...Next
Sub BoucleFeuilles()
Dim ws As Worksheet
For Each ws In Worksheets
' ton code à insérer
Next ws
End Sub
En espèrant que cela t'aide ...
Bonjour James,
Oui cela m'a beaucoup aidé. J'ai pu parcourir mes fichier finalement sur ton conseil. J'ouvre et lit chaque fichier avant de le fermé, le code fonctionne bien.
Seule contrainte, je veux qu'il lise les fichier en ordre de tri ( Ce qu'il ne fait pas). J'ai nommé les fichier en format entier de date: aaaamm. Normalement, l'affichage est ordonnée quand je regarde mon dossier.
Je ne comprends pas pourquoi le code lit les fichiers en désordre (enfin..... je veux dire, pas dans l'ordre d'affichage comme c'est dans le dossier).
Mon code fonctionnel qui lit en désordre:
Public Sub MatriceADD()
Dim Fichier As Variant, FichierDest As Variant
Dim FichierCible As String, cible As String, Chemin As String, CheminFichier As String
Dim d As String, c As String, f As String
Dim PlageTraitee As Range
Dim FeuilleDest As Worksheet, sheet As Worksheet, FeuilleP As Worksheet
Dim i As Integer, Decalage As Integer
cible = "ADD"
FichierCible = "Projet"
Set FeuilleDest = Workbooks(FichierCible).Worksheets(cible)
Decalage = 2
Chemin = "C: \users\jb\desktop\Extrations\Histo\"
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Boucle sur tous les fichiers xls du répertoire.
CheminFichier = Dir(Chemin & "*.*")
Do While Len(CheminFichier) > 0
c = Left(CheminFichier, Len(CheminFichier) - 5)
Workbooks.Open (c)
With Workbooks(c)
For Each sheet In .Worksheets
If sheet.Name = c Then
d = NomPlage(Right(c, 2))
Set PlageTraitee = sheet.Range(d)
FeuilleDest.Range(Decalage & ":" & (Decalage + PlageTraitee.Rows.Count + 2)).Insert shift:=xlDown
PlageTraitee.Copy
FeuilleDest.Range("A" & Decalage + 1).Value = sheet.Name
FeuilleDest.Range("A" & Decalage + 2).PasteSpecial Paste:=xlPasteFormats
FeuilleDest.Range("A" & Decalage + 2).PasteSpecial Paste:=xlPasteValues
FeuilleDest.Range("A" & Decalage + 2).HorizontalAlignment = xlCenter
FeuilleDest.Range("A" & Decalage + 2).VerticalAlignment = xlCenter
End If
Next sheet
End With
Workbooks(c).Close
CheminFichier = Dir(, vbNormal)
Loop
Supprimer_Lignes_Vides
End Sub
Public Sub Supprimer_Lignes_Vides()
Range("A1:A1000000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
Bonjour,
Content que tu aies trouvé la solution à ton problème ...
Merci ... pour tes remerciements ..