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 Sub

Je 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.

image

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 Sub

Cordialement.

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 sub

J'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 sub

Cdlt,

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.Name

et 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 = ThisWorkbook

Ensuite 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 0

Ce 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) ?

image

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 ?

image

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é ?

image 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 sub

Pour 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).

image

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 :

image

Onglet Planning Usinage :

image

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 :

image

Voilà in fine ce que je veux obtenir dans mon fichier de destination Synthplanning - Copie dans l'onglet S12 dans mon cas :

image

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 Function

Donc 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,

Rechercher des sujets similaires à "problemes codage macro exporter valeurs fichier autr"