Problèmes de codage macro pour exporter des valeurs d'un fichier -> un autr
Bonjour le Forum,
J'ai un problème sur un code à moi qui ne fonctionne pas dans sa totalité.
J'arrive à transférer certaines valeurs vers mon autre fichier mais pas toute. (Les valeurs que j'arrive à transférer je les ai marqué en commentaire et celle que je n'arrive pas aussi.
Sub exportverssyntheseplanning_Test5()
Application.ScreenUpdating = False
nom_fichier_lancement = ActiveWorkbook.Name ' Planning AJUSTAGE-USINAGE
CheminFichierPlanning = "\" ' Chemin d'accès synthèse planning (Fichier de destination)
nomfichierplanning = "SynthPlanning - Copie.xlsm" ' Nom fichier synthèse planning
Set ash = ActiveSheet
Set PlanningMetier = ActiveWorkbook ' Planning AJUSTAGE-USINAGE
num_ligne_metier = 3 ' Je défini de commencer à partir de la 3ème ligne du fichier Synthèse planning
On Error Resume Next
Windows(nomfichierplanning).Activate
If Err <> 0 Then
Set FichierPlanning = Workbooks.Open(CheminFichierPlanning & nomfichierplanning)
Else
Set FichierPlanning = ActiveWorkbook
End If
On Error GoTo 0
For J = 1 To nbonglet
Set ash = PlanningMetier.Sheets(J) ' Planning AJUSTAGE-USINAGE feuille J
nbligne = ash.Range("A" & Rows.Count).End(xlUp).Row
For I = 1 To nbligne - 7 ' -7 = Les valeurs du tableau synthèse planning commence à partir de la 7ème ligne
If ash.Cells(7 + I, 12).Value <= ladate And ash.Cells(7 + I, 12).Value + 2 >= ladate Then ' prendre en compte S+1 uniquement (12 = date engagement atelier)
' If ash.Cells(7 + I, 13).Value <> "" Then pourcentage = ash.Cells(7 + I, 13).Value Else pourcentage = 1 ' LA IL A MARQUER CA PARCE QUE IL PREND LA COLONNE HE DONC AUTANT PRENDRE HE CORRIGER DIRECTEMENT
If ash.Cells(7 + I, 12).Value <= ladate + 7 And ash.Cells(7 + I, 12).Value - 5 >= ladate Then ' Si la valeur date d'engagement atelier est plus petit ou égal à la date (S+1) + 7 et la valeur de date d'engagement -5 est plus grand ou égal à la date (S+1)alors (Then = Alors)
ladate = PlanningMetier.Sheets(1).Cells(4, 20).Value ' ladate = à la cellule T4 dans le fichier planning AJUSTAGE-USINAGE (C'est la date en S+1)
onglet = "s" & DatePart("ww", ladate, 2, 2) ' laisser les "2, 2 après la date ca place à la bonne semaine!
If Len(onglet) = 2 Then onglet = "s0" & DatePart("ww", ladate, 2, 2) ' If Len(onglet)= 2 Vérifie que le nom de l'onglet comporte au moins 2 caractères laisser les "2, 2 après la date ca place à la bonne semaine!
engatelier = PlanningMetier.Sheets(1).Cells(3, 5).Value ' L'engagement de l'atelier en S+1 = cellule E3 dans le fichier planning onglet 1
OPlanifié = PlanningMetier.Sheets(3).Cells(2, 4).Value ' Le nombre d'OP planifié en S+1 = cellule E2 dans le fichier planning onglet 3
FileDattente = PlanningMetier.Sheets(3).Cells(6, 3).Value ' La file d'attente = cellule C6 dans le fichier planning onglet 3
OF = PlanningMetier.Sheets(1).Range(A).Value
OP = PlanningMetier.Sheets(1).Range(B).Value
denomination = PlanningMetier.Range(D).Value
He = PlanningMetier.Range(P).Value
On Error GoTo PbOnglet
FichierPlanning.Sheets(onglet).Cells(num_ligne_metier, 9).Value = engatelier ' Copier la valeur dans le synthèse planning -> MARCHE
FichierPlanning.Sheets(onglet).Cells(num_ligne_metier, 10).Value = OPlanifié ' Copier la valeur dans le synthèse planning -> MARCHE
FichierPlanning.Sheets(onglet).Cells(num_ligne_metier, 14).Value = FileDattente ' Copier la valeur dans le synthèse planning -> MARCHE
FichierPlanning.Sheets(onglet).Cells(num_ligne_metier, 3).Value = OF ' Copier la valeur dans le synthèse planning -> NE MARCHE PAS
FichierPlanning.Sheets(onglet).Cells(num_ligne_metier, 4).Value = OP ' Copier la valeur dans le synthèse planning -> NE MARCHE PAS
FichierPlanning.Sheets(onglet).Cells(num_ligne_metier, 5).Value = denomination ' Copier la valeur dans le synthèse planning -> NE MARCHE PAS
FichierPlanning.Sheets(onglet).Cells(num_ligne_metier, 6).Value = He ' Copier la valeur dans le synthèse planning -> NE MARCHE PAS
End If
End If
Next
Next
Windows(nom_fichier_lancement).Activate ' Le fichier planning AJUSTAGE-USINAGE est actif
Application.ScreenUpdating = True ' Application.ScreenEpdating = True la mise à jour de l'écran est activée
On Error GoTo 0
Exit Sub
' Si il y a une erreur alors il apparait le message L'onglet "" n'existe pas dans le fichier Synthèse planning
PbOnglet:
MsgBox "L'onglet " & onglet & " n'existe pas dans le fichier 'synthèse planning.xlsm'"
Application.ScreenUpdating = True ' Application.ScreenEpdating = True la mise à jour de l'écran est activée
Application.Calculation = xlCalculationAutomatic ' Calcul automatique
Exit Sub
End SubJe ne comprends pas d'ou peux venir le problème car je n'ai aucune erreur qui me bloque ma formule. Je pense que j'ai mal marqué quelque chose mais je n'arrive pas à trouver quoi...
Si quelqu'un a une idée..?
Merci d'avance.
Bonne journée à tous.
Bonjour,
Je réponds sans conviction car les commentaires rendent le code illisible.
A première vue, je dirais que l'affectation de la variable onglet est soumise à 2 conditions. Donc si ces conditions ne sont jamais vérifiées, onglet n'est jamais initialisé (reste vide), il y a ensuite une erreur et le message renvoie une chaine vide.
Cdlt,
Si quelqu'un veut regardé voici les fichiers de travail.
Le fichier Planning Ajustage-Usinage est le fichier source de la macro. Le fichier SynthPlanning est le fichier de destination pour la macro.
Pour essayé la macro cliquer sur le bouton export SP Semaine S+1 que l'ont retrouve sur chaque onglet du planning Ajustage-Usinage.
Bonjour 3GB,
Tout d'abord merci pour ta réponse mais malheureusement je n'ai pas assez de connaissance en VBA et donc je ne sais pas trop quoi faire...
J'ai mit ci-dessous mes fichiers si jamais tu veux jeter un coup d'oeil...
Merci encore pour ta réponse.
Bonne journée.
Le code avec moins de commentaires :
Sub exportverssyntheseplanning_Test5()
Application.ScreenUpdating = False
nom_fichier_lancement = ActiveWorkbook.Name ' Planning AJUSTAGE-USINAGE
CheminFichierPlanning = "\" ' Chemin d'accès synthèse planning (Fichier de destination)
nomfichierplanning = "SynthPlanning - Copie.xlsm" ' Nom fichier synthèse planning
Set ash = ActiveSheet
Set PlanningMetier = ActiveWorkbook ' Planning AJUSTAGE-USINAGE
num_ligne_metier = 3
On Error Resume Next
Windows(nomfichierplanning).Activate
If Err <> 0 Then
Set FichierPlanning = Workbooks.Open(CheminFichierPlanning & nomfichierplanning)
Else
Set FichierPlanning = ActiveWorkbook
End If
On Error GoTo 0
For J = 1 To nbonglet
Set ash = PlanningMetier.Sheets(J)
nbligne = ash.Range("A" & Rows.Count).End(xlUp).Row
For I = 1 To nbligne - 7
If ash.Cells(7 + I, 12).Value <= ladate And ash.Cells(7 + I, 12).Value + 2 >= ladate Then
If ash.Cells(7 + I, 12).Value <= ladate + 7 And ash.Cells(7 + I, 12).Value - 5 >= ladate Then
ladate = PlanningMetier.Sheets(1).Cells(4, 20).Value
onglet = "s" & DatePart("ww", ladate, 2, 2)
If Len(onglet) = 2 Then onglet = "s0" & DatePart("ww", ladate, 2, 2)
engatelier = PlanningMetier.Sheets(1).Cells(3, 5).Value
OPlanifié = PlanningMetier.Sheets(3).Cells(2, 4).Value
FileDattente = PlanningMetier.Sheets(3).Cells(6, 3).Value
OF = PlanningMetier.Sheets(1).Range(A).Value
OP = PlanningMetier.Sheets(1).Range(B).Value
denomination = PlanningMetier.Range(D).Value
He = PlanningMetier.Range(P).Value
On Error GoTo PbOnglet
'Exporter les valeurs vers le fichier Synthèse Planning Copie
FichierPlanning.Sheets(onglet).Cells(num_ligne_metier, 9).Value = engatelier ' -> MARCHE
FichierPlanning.Sheets(onglet).Cells(num_ligne_metier, 10).Value = OPlanifié ' -> MARCHE
FichierPlanning.Sheets(onglet).Cells(num_ligne_metier, 14).Value = FileDattente ' -> MARCHE
FichierPlanning.Sheets(onglet).Cells(num_ligne_metier, 3).Value = OF ' -> NE MARCHE PAS
FichierPlanning.Sheets(onglet).Cells(num_ligne_metier, 4).Value = OP ' -> NE MARCHE PAS
FichierPlanning.Sheets(onglet).Cells(num_ligne_metier, 5).Value = denomination ' -> NE MARCHE PAS
FichierPlanning.Sheets(onglet).Cells(num_ligne_metier, 6).Value = He ' -> NE MARCHE PAS
End If
End If
Next
Next
Windows(nom_fichier_lancement).Activate
Application.ScreenUpdating = True
On Error GoTo 0
Exit Sub
' Si il y a une erreur alors il apparait le message L'onglet "" n'existe pas dans le fichier Synthèse planning
PbOnglet:
MsgBox "L'onglet " & onglet & " n'existe pas dans le fichier 'synthèse planning.xlsm'"
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Exit Sub
End SubCordialement.
Voici un premier essai d'adaptation du code :
Sub exportverssyntheseplanning_Test5()
on error resume next
set wbplanning = workbooks("\SynthPlanning - Copie.xlsm")
If Err.number = 9 Then Set wbplanning = Workbooks.Open("\SynthPlanning - Copie.xlsm")
if err.number = 1004 then msgbox "Erreur : fichier introuvable", 16: exit sub
On Error GoTo 0
'------REMARQUES IMPORTANTES
'ladate : pas intialisée avant la boucle
'les variables (références) A, B, D, P : pas initialisées
'--------------------------------
with thisworkbook
nbligne = .activesheet.Range("A" & .Rows.Count).End(xlUp).Row
For I = 8 To nbligne
If .activesheet.Cells(I, 12).Value <= ladate And .activesheet.Cells(I, 12).Value + 2 >= ladate Then
If .activesheet.Cells(I, 12).Value <= ladate + 7 And .activesheet.Cells(I, 12).Value - 5 >= ladate Then
ladate = .Sheets(1).Cells(4, 20).Value
onglet = "s" & format(DatePart("ww", ladate, 2, 2), "00")
tcopie = array(.Sheets(1).Cells(3, 5).Value, .Sheets(3).Cells(2, 4).Value, .Sheets(3).Cells(6, 3).Value, _
.Sheets(1).Range(A).Value, .Sheets(1).Range(B).Value, .Range(D).Value, .Range(P).Value)
with wbplanning.Sheets(onglet)
for j = lbound(tcopie) to ubound(tcopie)
col = choose(j + 1, 9, 10, 14, 3, 4, 5, 6)
.cells(3, col).value = tcopie(j)
next j
end with
End If
End If
Next
end with
end subJ'ai essayé d'enlever le plus de variables possible, tout ce que j'ai considéré comme "inutile" pour le moment ou qui empecherait de correctement tester.
Je n'ai peut-être pas tout compris et mal interprété. En tout cas :
- activeworkbook devient thisworkbook, le classeur exécutant,
- on boucle de 8 à la fin directement pour simplifier la lecture du code,
- on met toutes les valeurs à copier dans un tableau dynamique et on les restitue avec une boucle. C'est beaucoup plus simple et court. D'ailleurs, au lieu d'avoir 30 variables (qui ne sont pas initialisées - elles sont publiques ?), tu devrais nommer tes 7 cellules que tu copies, ce serait beaucoup plus simple.
Il faut faire attention aux valeurs des variables ladate, A, B, D, P, ce sont des éléments susceptibles de générer des erreurs.
Ensuite, il faudra regarder les conditions de la boucle de plus près...
Cdlt,
Voici maintenant une proposition tel que je vois la chose :
Sub exportverssyntheseplanning_Test5()
on error resume next
set wbplanning = workbooks("\SynthPlanning - Copie.xlsm")
If Err.number = 9 Then Set wbplanning = Workbooks.Open("\SynthPlanning - Copie.xlsm")
if err.number = 1004 then msgbox "Erreur : fichier introuvable", 16: exit sub
On Error GoTo 0
'------REMARQUES IMPORTANTES
'ladate : pas intialisée avant la boucle
'les variables (références) A, B, D, P : pas initialisées
'--------------------------------
with thisworkbook
nbligne = .activesheet.Range("A" & .Rows.Count).End(xlUp).Row
ladate = .Sheets(1).Cells(4, 20).Value
onglet = "s" & format(DatePart("ww", ladate, 2, 2), "00")
tcopie = array(.range("nom1").Value, .range("nom2").Value, .range("nom3").Value, .range("nom4").Value, _
.range("nom5").Value, .range("nom6").Value, .range("nom7").Value)
For I = 8 To nbligne
If .activesheet.Cells(I, 12).Value <= ladate And .activesheet.Cells(I, 12).Value + 2 >= ladate Then
If .activesheet.Cells(I, 12).Value <= ladate + 7 And .activesheet.Cells(I, 12).Value - 5 >= ladate Then
with wbplanning.Sheets(onglet)
nvl = .cells(.rows.count, 3).end(xlup).row + 1
for j = lbound(tcopie) to ubound(tcopie)
col = choose(j + 1, 9, 10, 14, 3, 4, 5, 6)
.cells(nvl, col).value = tcopie(j)
next j
end with
End If
End If
Next
end with
end subCdlt,
Il y a bien un problème au niveau des conditions. Il faut les réunir par un OR car ladate ne peut appartenir à 2 intervalles dont l'intersection est nulle...
Bonjour Zelamo, bonjour le forum,
Déjà tu ne déclares aucune variable. Ce n'est pas interdit mais ça n'aide pas.
Tu utilises une variable type String :
nom_fichier_lancement = ActiveWorkbook.Nameet une autre variable type Workbook pour la même chose :
Set PlanningMetier = ActiveWorkbookÇa embrouille...
Je pense que ton problème se situe ici. Pour spécifier le classeur qui contient la macro mieux vaut utiliser ThisWorkbook à la place de ActiveWorkbook.
Set PlanningMetier = ThisWorkbookEnsuite je n'ai pas compris :
Windows(nomfichierplanning).Activate
If Err <> 0 Then
Set FichierPlanning = Workbooks.Open(CheminFichierPlanning & nomfichierplanning)
Else
Set FichierPlanning = ActiveWorkbook
End If
On Error GoTo 0Ce qui signifie que si le classeur n'est pas ouvert le classeur source sera le même que le classeur destination ?!... Pas très clair...
[Édition]
Hou la... J'ai été interrompu au boulot et je n'avais pas vu les réponses de 3GB (que je salue au passage). Je suis donc certainement hors sujet...
Bonjour Messieurs,
Merci pour vos réponses j'apprécie vos aides.
Pour répondre à 3GB,
J'ai plusieurs questions sur ton code.
La première, on est d'accord qu'il faut rajouter l'emplacement de mon fichier avant les slash "\" (voir ci-dessous) ?
La deuxième, tous les mots marqués "nom1","nom2","nom3",.... ; correspondent aux lettres de mes colonnes que je veux copier c'est bien ça ?
Ps : Est ce que c'est possible que tu marques sur les codes à quoi correspondent t'es lignes de code (je ne comprends pas tout).
Merci d'avance pour t'es réponses.
Pour répondre à ThauThème,
Merci encore pour ton aide!
Ce que j'ai voulu dire c'est que si le fichier de destination n'est pas ouvert alors on l'ouvre et on le rend actif. Je ne sais pas si c'est bien marqué ?
Merci encore pour vos réponses.Cordialement.
Re,
Hé bé non ! c'était pas bien marqué... Mais le code de 3GB lui est impeccable (pour ce problème là) mais je lui laisse le soin de régler ton problème...
Bonsoir Zelamo, Salut Thauthème,
Voici le code commenté et un peu réorganisé (mais il n'est pas encore fonctionnel...).
Sub exportverssyntheseplanning_Test5()
with thisworkbook 'avec classeur exécutant (source)
'initialisation source
ladate = .Sheets(1).Cells(4, 20).Value 'initialisation ladate
onglet = "s" & format(DatePart("ww", ladate, 2, 2), "00") 'nom onglet format au s00 (sera destination)
tcopie = array(range("nom1").Value, range("nom2").Value, range("nom3").Value, range("nom4").Value, _
range("nom5").Value, range("nom6").Value, range("nom7").Value) 'ensemble des valeurs à copier
nbligne = .activesheet.Range("A" & .Rows.Count).End(xlUp).Row 'derniere ligne feuille active
'ouverture et affectation destination
on error resume next 'pour gérer éventuelle erreur lors de l'affectation du classeur destination
set wbplanning = workbooks("\SynthPlanning - Copie.xlsm") 'affectation classeur destination (si ouvert)
If Err.number = 9 Then Set wbplanning = Workbooks.Open("\SynthPlanning - Copie.xlsm") 'si classeur absent, ouverture et affectation
if err.number = 1004 then msgbox "Erreur : fichier introuvable", 16: exit sub 'si classeur inexistant, sortie
On Error GoTo 0 'fin gestion erreur
'collage valeurs
For I = 8 To nbligne 'pour chaque ligne à partir de la 8
If .activesheet.Cells(I, 12).Value <= ladate And .activesheet.Cells(I, 12).Value + 2 >= ladate Then 'si cellule L ds intervalle
If .activesheet.Cells(I, 12).Value <= ladate + 7 And .activesheet.Cells(I, 12).Value - 5 >= ladate Then
with wbplanning.Sheets(onglet) 'avec onglet destination
nvl = .cells(.rows.count, 3).end(xlup).row + 1 'nouvelle ligne
for j = lbound(tcopie) to ubound(tcopie) 'pour chaque item du tableau des valeurs copiées
col = choose(j + 1, 9, 10, 14, 3, 4, 5, 6) 'colonne correspondante pour collage
.cells(nvl, col).value = tcopie(j) 'cellule à la colonne en cours et à la nvlle ligne vaut item tcopie en cours
next j
end with
End If
End If
Next
end with
end subPour répondre aux questions :
Oui, j'ai juste repris la matière à disposition mais il faut un vrai chemin existant et pas seulement l'antislash.
Les range("nom1"), ... correspondent aux 7 cellules à copier (ex : .Sheets(1).Cells(3, 5).Value). Mais ici, je suppose qu'on leur a donné un nom via le gestionnaire de noms. Ce n'est pas obligatoire. Et bien sûr, les noms seront à adapter...
Pour l'instant, il s'agit surtout de réorganisation de code, un peu à l'aveugle car je ne sais pas vraiment ce qu'il faut faire. En tout cas, j'attire ton attention sur le fait de bien définir certains objets, dont notamment les feuilles. Dans le code, à moins qu'Activesheet puisse varier (auquel cas il faudra remettre la variable que tu avais), il faudra la cibler par son nom ou son index. Car en fait, elle n'est plus la feuille active dès l'ouverture du classeur de destination.
Voilà, pour l'instant, c'est un code qui ne fonctionne pas en toute situation (et d'ailleurs qui ne fait rien avec les conditions au sein de la boucle).
Cdlt,
Rebonjour,
Encore merci pour t'es réponses,
Je vais expliquer ce que je veux plus en détail.
Chaque semaine je veux faire une extract des OF planifié en semaine +1 (qu'on retrouve dans le fichier source Planning Ajustage-Usinage) vers un fichier de destination qui est le fichier SynthPlanning - Copie.
Dans mon cas la semaine S+1 la date de fin est le 26 mars et elle correspond à la semaine 12 (La valeur que l'on retrouve en cellule T4 dans mon fichier source Planning Ajustage-Usinage).
Dans mon fichier source j'ai en tout 3 onglets (Planning Ajustage, Planning Usinage et Synth Ajustage-Usinage). Je veux avec la macro lui dire pour les onglets Planning Ajustage et Planning Usinage de chercher les lignes ou la date d'engagement de l'atelier correspond à la date de fin de semaine S+1 (26 mars) et copié les valeurs en jaune sur le fichier de destination SynthPlanning - Copie dans l'onglet que j'ai créé en amont dans mon cas S12.
Onglet Planning Ajustage :
Onglet Planning Usinage :
Je veux ensuite lui dire dans l'onglet Synth Ajustage-Usinage de prendre les valeurs dans les cellules que j'ai surlignées en jaune et les copier vers le fichier de destination SynthPlanning - Copie.
Onglet Synth Ajustage-Usinage :
Voilà in fine ce que je veux obtenir dans mon fichier de destination Synthplanning - Copie dans l'onglet S12 dans mon cas :
Cordialement.
Salut Zelamo,
Je viens de regarder les fichiers, j'aurais dû le faire avant, désolé.
Je ne suis pas sûr de bien comprendre pour l'instant. J'ai plusieurs questions :
Est-il nécessaire d'avoir 2 onglets différentes Ajustage et Usinage ?
Je verrais plutôt un onglet de saisie et ensuite des extractions ciblées, que ce soit sur la date ou autre.
Dans ton cas, il faut des tableaux structurés, aucune fusion de cellules, et récupérer seulement les infos utiles (OF, OP, Dénomination, ...) ! Le reste, qui ne semble pas fondamental, on peut l'obtenir avec des formules j'ai l'impression.
Cdlt,
Bonjour,
Pas de problème merci pour ton aide,
Et pour le coup non malheureusement je suis obligé de garder les 2 onglets Ajustage et Usinage je ne peux pas rassembler les 2 dans un seul onglet...
Je dois aussi garder la structure des tableaux dans les deux onglets.
Pour la structure de mon fichier de destination, pour tout ce qui est fusion de cellules, bordures, etc je le ferai moi-même manuellement il y a pas de soucie.
Je veux "juste" trouver un moyen pour reporter les infos (OF, OP, HE, Désignation) en sélectionnant que celle qui corresponde à la date de S+1 et transférer la valeur des cellules pour HE total, Nb Of planifié et file d'attente.
Bonjour Zelamo,
J'ai compris pour les onglets, un peu moins pour les tableaux. Je te propose une solution avec des tableaux structurés (je n'envisage pas de faire sans). J'ai pas mal retouché le fichier mais c'est pour l'exercice, ce qui explique que les formules renvoient une valeur d'erreur maintenant...
Voici les codes du classeur source :
Sub Archiver()
Dim ladate As Date, sem$, chemin$, wbsynth As Workbook
ladate = Date - Weekday(Date, vbMonday) + 12 'date fin s+1
sem = "S" & Format(DatePart("ww", ladate, 2, 2), "00") 'semaine formatée
chemin = Environ("userprofile") & "\Downloads\synthplanning-copie.xlsm" 'chemin <<< A ADAPTER !!!!
t = ExtraireSemaine(ladate) 'tableau obtenu avec la date s+1
Set wbsynth = AffecterClasseur(chemin) 'affectation classeur synthese, le cas échéant ouverture
If wbsynth Is Nothing Then MsgBox "Fichier introuvable", 16: Exit Sub 'si existe pas, sortie
With wbsynth 'avec synthese
If Not FeuilleExiste(.Name, sem) Then 'si feuille semaine n'existe pas
.Sheets("MODELE").Copy after:=.Sheets(.Sheets.Count) 'on la crée en copiant la feuille masquée "MODELE"
With .Sheets(.Sheets.Count) 'avec la nvlle feuille
.Name = sem 'on la renomme
.Visible = True 'on la rend visible
.ListObjects(1).Name = sem & "_" 'on renomme son tableau structuré
End With
End If
With .Sheets(sem).Range(sem & "_") 'avec le tab structuré
If .Rows.Count > 1 Then .Delete Else .ClearContents 'on efface tout
If IsArray(t) Then .Cells(1, 1).Resize(UBound(t), UBound(t, 2)).Value = t 'si tableau valeurs non vide, on colle les nvlles val
End With
End With
End Sub
Function ExtraireSemaine(datefin As Date)
Dim t()
tcol = Application.Transpose(Application.Transpose(Array(1, 2, 3, 6, 16)))
For Each ws In ThisWorkbook.Worksheets
If ws.Name Like "*age" Then
With ws.ListObjects(1).DataBodyRange
For i = 1 To .Rows.Count
If .Cells(i, 11).Value = datefin Then
n = n + 1
ReDim Preserve t(1 To UBound(tcol) + 1, 1 To n)
t(1, n) = ws.Name
For k = LBound(tcol) To UBound(tcol)
t(k + 1, n) = .Cells(i, tcol(k))
Next k
End If
Next i
End With
End If
Next ws
If n > 0 Then ExtraireSemaine = Application.Transpose(t)
End Function
Function AffecterClasseur(chemin$) As Workbook
On Error Resume Next
Set AffecterClasseur = Workbooks(Split(chemin, "\")(UBound(Split(chemin, "\"))))
If Err.Number = 9 Then Set AffecterClasseur = Workbooks.Open(chemin)
End Function
Function FeuilleExiste(NomClasseur$, NomFeuille$) As Boolean
On Error Resume Next
FeuilleExiste = Workbooks(NomClasseur$).Sheets(NomFeuille).Index
End FunctionDonc j'ai supprimé le code du classeur de destination pour gérer la création directement lors de l'import.
Les nouvelles valeurs écrasent les anciennes.
Pour l'instant, la date s+1 dépend de la date du jour (dans le code) mais on peut changer ce détail.
Il faudra adapter le chemin (pour l'instant fonctionnel avec les fichiers dans le dossier téléchargements).
Il ne faut pas fusionner les cellules, c'est contraire au principe du tableur et empêche la plupart des fonctionnalités utiles.
Ici, le test de la date porte sur la colonne 11 des tableaux structurés du fichier source. Pour l'exemple, on ne copie pour l'instant que les colonnes 1, 2, 3, 6 et 16.
Si tu as des questions, n'hésite pas.
Cdlt,