floflo2411
XLDnaute Nouveau
Bonjour à tous,
J'ai une macro qui me permet de récupérer des données d'un classeur source qui contient plusieurs feuilles. Je souhaite trouver une formule qui va chercher les données sur plusieurs feuilles d'un classeur (toutes sauf les 3 premières) pour éviter de recopier la formule qui permet de récupérer les données, car il y a de nombreuses feuilles et le nom des feuilles différent d'un classeur à un autre.
Cordialement,
Florent B.
J'ai une macro qui me permet de récupérer des données d'un classeur source qui contient plusieurs feuilles. Je souhaite trouver une formule qui va chercher les données sur plusieurs feuilles d'un classeur (toutes sauf les 3 premières) pour éviter de recopier la formule qui permet de récupérer les données, car il y a de nombreuses feuilles et le nom des feuilles différent d'un classeur à un autre.
Code:
Sub RecupHeures()
Dim cc As Workbook 'déclare la variable cc (Classeur Cible)
Dim oc As Object 'déclare la variable oc (Onglet Cible)
Dim ch As String
Dim ad As Range 'déclare la variable ad (Anciennes Données)
Dim sf As Object 'déclare la variable sf (Systeme de Fichier)
Dim d As Object 'déclare la variable d (Dossier)
Dim fs As Object 'déclare la variable fs (FichierS du dossier d)
Dim f As Object 'déclare la variable f (Fichier)
Dim cs As Workbook 'déclare la variable cs (Classeur Source)
Dim os As Object 'déclare la variable os (Onglet Source)
Dim dest As Range 'déclare la varaible dest (cellule de Destination)
Set cc = ThisWorkbook 'définit le classeur cible
Set oc = cc.Sheets("Feuil1") 'définit l'onglet cible
ch = cc.Path 'définit le chemin d'accès
Set ad = oc.Range("A1").CurrentRegion 'définit la plage des anciennes données
If ad.Rows.Count > 1 Then 'condition : si la plage des anciennes données contient plus d'une seule ligne
Set ad = ad.Offset(1, 0).Resize(ad.Rows.Count - 1, ad.Columns.Count) 'redéfinit la plage (sans la première ligne)
ad.ClearContents 'efface les anciennes données
End If 'fin de la condition
Set sf = CreateObject("Scripting.FileSystemObject") 'définit le syteme de fichier sf
Set d = sf.GetFolder(ch) 'définit le dossier de travail d
Set fs = d.Files 'définit les fichiers fs du dossier d
For Each f In fs 'boucle sur tous les fichier f du dossier d
If f.Name <> "Recap Heures.xls" Then 'si le nom du fichier est différent de "Recap Heures.xls"
Workbooks.Open (f) 'ouvre le fichier
Set cs = ActiveWorkbook 'définit le classeur source
Set os = cs.Sheets("DI TOMASSO J.") 'définit l'onglet source
Set dest = oc.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'définit la cellule de destination
dest.Value = os.Range("Q2") 'récupère le Nom Salarié
dest.Offset(0, 1).Value = os.Range("V4") 'récupère le num semaine
dest.Offset(0, 2).Value = os.Range("C12") 'récupère le num affaire 1
dest.Offset(0, 3).Value = os.Range("D18") 'récupère heure J1
dest.Offset(0, 4).Value = os.Range("D19") 'récupère heure J2
dest.Offset(0, 5).Value = os.Range("D20")
dest.Offset(0, 6).Value = os.Range("D21")
dest.Offset(0, 7).Value = os.Range("D22")
dest.Offset(0, 8).Value = os.Range("D23")
dest.Offset(0, 9).Value = os.Range("D24")
dest.Offset(0, 10).Value = os.Range("I12") 'récupère le num affaire 2
dest.Offset(0, 11).Value = os.Range("J18")
dest.Offset(0, 12).Value = os.Range("J19")
dest.Offset(0, 13).Value = os.Range("J20")
dest.Offset(0, 14).Value = os.Range("J21")
dest.Offset(0, 15).Value = os.Range("J22")
dest.Offset(0, 16).Value = os.Range("J23")
dest.Offset(0, 17).Value = os.Range("J24")
dest.Offset(0, 18).Value = os.Range("O12") 'récupère le num affaire 3
dest.Offset(0, 19).Value = os.Range("P18")
dest.Offset(0, 20).Value = os.Range("P19")
dest.Offset(0, 21).Value = os.Range("P20")
dest.Offset(0, 22).Value = os.Range("P21")
dest.Offset(0, 23).Value = os.Range("P22")
dest.Offset(0, 24).Value = os.Range("P23")
dest.Offset(0, 25).Value = os.Range("P24")
cs.Close SaveChanges:=False 'ferme le classeur source
cc.Save 'enregistre le classeur cible
End If 'fin de la condition
Next f 'prochain fichier de la boucle
End SubCordialement,
Florent B.
