SaveAS

Bonjour,

J'ai un macro fait l'enregistrer sous d'un fichier excel avec le nom d'une cellule dans un tableau et fait le remplissage de ce fichier lors de l'enregistrement avec des données à partir de tableau alors j'ai un problème quand j'ai modifier quelque chose dans le tableau et j'ai lancer l’exécution du macro les données qu j'ai les modifier dans le tableau n'est pas modifier dans les fichiers.

Comment je peut modifier mon macro pour faire la le mis à jour dans les fichiers?

Sub MO()
Dim NomFicheM As String, i, j, t, s As Integer, ligne, fin As Integer
Dim Xl As Excel.Application, Wbk As Excel.Workbook
Dim Plan As String
Dim Fiche As String
Dim Article As String
Dim emplacementM As String
Dim CheminM As String, FichierM As String
Dim mouleAs String

ligne = Cells(Rows.Count, 6).End(xlUp).Row ' compter le nombre de ligne dans la colonne des moules
Fiche = "C:\Users\Dream\Desktop\Nouveaudossier\outillage\fiche.xlsx" '<-- adapter chemin et nom du model fichier excel à ouvrir
Set Xl = New Excel.Application
Xl.Visible = False '<-- Fiche.xlsx reste invisible
Set Wbk = Xl.Workbooks.Open(Fiche) 'ouvrir le fichier excel "Fiche.xlsx"
CheminM = "C:\Users\Dream\Desktop\fiche de vie Moule" ' adapter le chemin de dossier où les fiches de moule seront enregistrés
DirectionM = dir("C:\Users\Dream\Desktop\fiche de vie Moule\*.xls") 'adapter chemin repertoire et ajouter "\*.xls" pour dire tout les fichiers("C:\Users\Dream\Desktop\Nouveau dossier")
For i = 2 To ligne
t = 7
NomFicheM = Cells(i, 6) 'le variable NomFichierM contient chaque fois le nom de cellule Moule
Plan = Cells(i, 3) 'le variable Plan contient chaque fois le Plan
emplacementM = Cells(i, 7) 'le variable emplacementM contient chaque fois l'emplacemen de la moule
FichierM = CheminM & "\" & NomFicheM & ".xls" ' le chemin de chaque fiche de vie Moule
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 6), Address:=FichierM, TextToDisplay:=Cells(i, 6).Value ' creation de lien entre la cellule Moule et son fichier
'boucle de renommer et enregistrer sous les fichies de vie Moule
If dir(FichierM) = "" Then
Wbk.Sheets(1).Range("B6") = NomFicheM ' ecrire dans B6 le N° d'outil Moule dans chaque fichier lors de son enregistrement
Wbk.Sheets(1).Range("B11") = Plan ' ecrire dans B11 le Plan dans chaque fichier lors de son enregistrement
Wbk.Sheets(1).Range("B13") = emplacementM ' ecrire dans B13 l'emplacement de Moule dans chaque fichier lors de son enregistrement
fin = Wbk.Sheets(1).Cells(Rows.Count, 8).End(xlUp).Row ' compter la colonne H
' Vider la colonne H
For s = 7 To fin
Wbk.Sheets(1).Cells(s, 8) = " "
Next s

' insérer Les aticels dans la colonne H
For j = 2 To ligne
If Cells(i, 6).Value = Cells(j, 6).Value Then
Article = Cells(j, 1)
 Wbk.Sheets(1).Cells(t, 8) = Article
t = t + 1
Else
t = 7
End If
Next j

Wbk.SaveAs Filename:=FichierM 'l'enregistrement de fichier
End If
Next i
Wbk.Close ' fermer le fichier excel "Fiche.xlsx"
Xl.Quit
End Sub

bonjour

à tester, sur des fichiers de test !!!!!!

Sub MO()
Dim NomFicheM As String, i, j, t, s As Integer, ligne, fin As Integer
Dim Xl As Excel.Application, Wbk As Excel.Workbook
Dim Plan As String
Dim Fiche As String
Dim Article As String
Dim emplacementM As String
Dim CheminM As String, FichierM As String
Dim mouleAs String

ligne = Cells(Rows.Count, 6).End(xlUp).Row ' compter le nombre de ligne dans la colonne des moules
Fiche = "C:\Users\Dream\Desktop\Nouveaudossier\outillage\fiche.xlsx" '<-- adapter chemin et nom du model fichier excel à ouvrir
Set Xl = New Excel.Application
Xl.Visible = False '<-- Fiche.xlsx reste invisible
Set Wbk = Xl.Workbooks.Open(Fiche) 'ouvrir le fichier excel "Fiche.xlsx"
CheminM = "C:\Users\Dream\Desktop\fiche de vie Moule" ' adapter le chemin de dossier où les fiches de moule seront enregistrés
DirectionM = dir("C:\Users\Dream\Desktop\fiche de vie Moule\*.xls") 'adapter chemin repertoire et ajouter "\*.xls" pour dire tout les fichiers("C:\Users\Dream\Desktop\Nouveau dossier")
For i = 2 To ligne
t = 7
NomFicheM = Cells(i, 6) 'le variable NomFichierM contient chaque fois le nom de cellule Moule
Plan = Cells(i, 3) 'le variable Plan contient chaque fois le Plan
emplacementM = Cells(i, 7) 'le variable emplacementM contient chaque fois l'emplacemen de la moule
FichierM = CheminM & "\" & NomFicheM & ".xls" ' le chemin de chaque fiche de vie Moule
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 6), Address:=FichierM, TextToDisplay:=Cells(i, 6).Value ' creation de lien entre la cellule Moule et son fichier
'boucle de renommer et enregistrer sous les fichies de vie Moule
If dir(FichierM) = "" Then kill fichierM
Wbk.Sheets(1).Range("B6") = NomFicheM ' ecrire dans B6 le N° d'outil Moule dans chaque fichier lors de son enregistrement
Wbk.Sheets(1).Range("B11") = Plan ' ecrire dans B11 le Plan dans chaque fichier lors de son enregistrement
Wbk.Sheets(1).Range("B13") = emplacementM ' ecrire dans B13 l'emplacement de Moule dans chaque fichier lors de son enregistrement
fin = Wbk.Sheets(1).Cells(Rows.Count, 8).End(xlUp).Row ' compter la colonne H
' Vider la colonne H
For s = 7 To fin
Wbk.Sheets(1).Cells(s, 8) = " "
Next s

' insérer Les aticels dans la colonne H
For j = 2 To ligne
If Cells(i, 6).Value = Cells(j, 6).Value Then
Article = Cells(j, 1)
 Wbk.Sheets(1).Cells(t, 8) = Article
t = t + 1
Else
t = 7
End If
Next j

Wbk.SaveAs Filename:=FichierM 'l'enregistrement de fichier

Next i
Wbk.Close ' fermer le fichier excel "Fiche.xlsx"
Xl.Quit
End Sub

Bonjour

Bonjour h2so4

Dans la même optique (fichier existant)

Sub MO()
Dim NomFicheM As String, i, j, t, s As Integer, ligne, fin As Integer
Dim Xl As Excel.Application, Wbk As Excel.Workbook
Dim Plan As String
Dim Fiche As String
Dim Article As String
Dim emplacementM As String
Dim CheminM As String, FichierM As String
Dim moule As String

  ligne = Cells(Rows.Count, 6).End(xlUp).Row                            ' compter le nombre de ligne dans la colonne des moules
  Fiche = "C:\Users\Dream\Desktop\Nouveaudossier\outillage\fiche.xlsx"  '<-- adapter chemin et nom du model fichier excel à ouvrir
  Set Xl = New Excel.Application
  Xl.Visible = False                                                    '<-- Fiche.xlsx reste invisible
  Set Wbk = Xl.Workbooks.Open(Fiche)                                    'ouvrir le fichier excel "Fiche.xlsx"
  CheminM = "C:\Users\Dream\Desktop\fiche de vie Moule"                 ' adapter le chemin de dossier où les fiches de moule seront enregistrés
  DirectionM = Dir("C:\Users\Dream\Desktop\fiche de vie Moule\*.xls")   'adapter chemin repertoire et ajouter "\*.xls" pour dire tout les fichiers("C:\Users\Dream\Desktop\Nouveau dossier")
  For i = 2 To ligne
    t = 7
    NomFicheM = Cells(i, 6)                                             'le variable NomFichierM contient chaque fois le nom de cellule Moule
    Plan = Cells(i, 3)                                                  'le variable Plan contient chaque fois le Plan
    emplacementM = Cells(i, 7)                                          'le variable emplacementM contient chaque fois l'emplacemen de la moule
    FichierM = CheminM & "\" & NomFicheM & ".xls"                       ' le chemin de chaque fiche de vie Moule
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 6), Address:=FichierM, TextToDisplay:=Cells(i, 6).Value  ' creation de lien entre la cellule Moule et son fichier

    'boucle de renommer et enregistrer sous les fichies de vie Moule
    'If Dir(FichierM) = "" Then
      Wbk.Sheets(1).Range("B6") = NomFicheM                   ' ecrire dans B6 le N° d'outil Moule dans chaque fichier lors de son enregistrement
      Wbk.Sheets(1).Range("B11") = Plan                       ' ecrire dans B11 le Plan dans chaque fichier lors de son enregistrement
      Wbk.Sheets(1).Range("B13") = emplacementM               ' ecrire dans B13 l'emplacement de Moule dans chaque fichier lors de son enregistrement
      fin = Wbk.Sheets(1).Cells(Rows.Count, 8).End(xlUp).Row  ' compter la colonne H
      ' Vider la colonne H
      For s = 7 To fin
        Wbk.Sheets(1).Cells(s, 8) = " "
      Next s

      ' insérer Les aticels dans la colonne H
      For j = 2 To ligne
        If Cells(i, 6).Value = Cells(j, 6).Value Then
          Article = Cells(j, 1)
          Wbk.Sheets(1).Cells(t, 8) = Article
          t = t + 1
        Else
          t = 7
        End If
      Next j
      Application.DisplayAlerts = False   ' Ecrase le fichier éventuellement présent sans avertissement
      Wbk.SaveAs Filename:=FichierM       ' l'enregistrement de fichier
      Application.DisplayAlerts = True    ' Pas très utile à ce niveau de la macro
    'End If
  Next i
  Wbk.Close  ' fermer le fichier excel "Fiche.xlsx"
  Xl.Quit
End Sub

Bonjour,

Merci de me répondre, le code fonctionne correctement .

Cordialement.