AIDE MODIF MACRO

Résolu
Bonjour,
J'ai cette macro qui reprend une liste de noms de clients dans un fichier excel et crée un fichier par client d'après un modèle :
Sub crea_fichiers()

Set fso = CreateObject("Scripting.FileSystemObject")

For Each c In Sheets(2).Range("C3:C1001")
If Not IsEmpty(c) Then
ficdest = "\\Serveur3\dserveur\Récapitulatif Clients Lesquin\Clients\Clients Affrètement\" & CStr(c.Value) & ".xls"

If Not fso.FileExists(pficdest) Then
fso.CopyFile "\\Serveur3\dserveur\Récapitulatif Clients Lesquin\Clients\Clients Affrètement\Modèle.xls", ficdest
End If
End If
Next c

End Sub

Est il possible en ajoutant un code qu'elle colle dans ce fichier créé le nom du client en B1 dans la feuille 1, en A1 dans la feuille 2 et en B1 dans la feuille 3 ?

Merci d'avance,
Gwénaël
Configuration: Windows XP Internet Explorer 7.0

7 réponses

  1. oui c'est possible!
    après le dernier end if et avant le next..... le code en gras

    Sub crea_fichiers()

    Set fso = CreateObject("Scripting.FileSystemObject")

    For Each c In Sheets(2).Range("C3:C1001")
    If Not IsEmpty(c) Then
    ficdest = "\\Serveur3\dserveur\Récapitulatif Clients Lesquin\Clients\Clients Affrètement\" & CStr(c.Value) & ".xls"

    If Not fso.FileExists(pficdest) Then
    fso.CopyFile "\\Serveur3\dserveur\Récapitulatif Clients Lesquin\Clients\Clients Affrètement\Modèle.xls", ficdest
    End If
    End If

    Workbooks.Open ficdest

    Sheets("Feuil1").Range("B1").Value = C.Value
    Sheets("Feuil2").Range("A1").Value = C.Value
    Sheets("Feuil3").Range("B1").Value = C.Value
    ActiveWorkbook.Save
    ActiveWorkbook.Close


    Next c

    End Sub
    0
    1. Contributeur
      Bonjour Gwen59000,
      Juste une petite correction, je viens de voir une faute de frappe sur le code que je t'avais donné :
      If Not fso.FileExists(pficdest) => If Not fso.FileExists(ficdest)
      0
      1. Bonjour à vous,

        Petit problème, lorque la macro ne crée plus de fichier lorsque la liste de noms est vide la copie du nom sur la feuille 1, 2 et 3 continue sur toute la plage sélectionnée.

        Peut on demander de faire une copie du nom sur les feuilles seulement si le fichier n'existe et s'arrêter une fois que les cellules sont vides dans la liste (comme le fait le code pour la création des fichiers).

        Sinon c'est parfait.
        0
        1. Ben! oui! j'ai fait le test sur 10... ma faute
          on ajoute deux lignes pour sortir de la boucle

          après le test if isisempty(....) ' si la cellule est vide on quitte la boucle for next
          merci à tompols pourla correction, ; )
          Sub crea_fichiers()

          Set fso = CreateObject("Scripting.FileSystemObject")

          For Each c In Sheets(2).Range("C3:C1001")
          If Not IsEmpty(c) Then
          ficdest = "\\Serveur3\dserveur\Récapitulatif Clients Lesquin\Clients\Clients Affrètement\" & CStr(c.Value) & ".xls"

          If Not fso.FileExists(ficdest) Then
          fso.CopyFile "\\Serveur3\dserveur\Récapitulatif Clients Lesquin\Clients\Clients Affrètement\Modèle.xls", ficdest
          End If
          else
          exit for
          End If

          Workbooks.Open ficdest

          Sheets("Feuil1").Range("B1").Value = C.Value
          Sheets("Feuil2").Range("A1").Value = C.Value
          Sheets("Feuil3").Range("B1").Value = C.Value
          ActiveWorkbook.Save
          ActiveWorkbook.Close

          Next c

          End Sub
          0
          1. Re

            excusez moi, me suis trompé

            Petit problème, alors que la macro ne crée plus de fichier lorsque la liste de noms est vide la copie du nom sur la feuille 1, 2 et 3 continue sur toute la plage sélectionnée.

            Peut on demander de faire une copie du nom sur les feuilles seulement s'il y a une création de fichier et s'arrêter une fois que les cellules sont vides dans la liste (comme le fait le code pour la création des fichiers).

            Merci
            0
            1. Contributeur
              Re,
              il suffit de déplacer le code donné par Bidouilleu_R dans une des 2 clauses If :
              Sub crea_fichiers()
              
              Set fso = CreateObject("Scripting.FileSystemObject")
              
              For Each c In Sheets(2).Range("C3:C1001")
                  
                  If Not IsEmpty(c) Then
                      ficdest = "\\Serveur3\dserveur\Récapitulatif Clients Lesquin\Clients\Clients Affrètement\" & CStr(c.Value) & ".xls"
                      
                      If Not fso.FileExists(ficdest) Then
                          fso.CopyFile "\\Serveur3\dserveur\Récapitulatif Clients Lesquin\Clients\Clients Affrètement\Modèle.xls", ficdest
                          Workbooks.Open ficdest
                          Sheets("Feuil1").Range("B1").Value = c.Value
                          Sheets("Feuil2").Range("A1").Value = c.Value
                          Sheets("Feuil3").Range("B1").Value = c.Value
                          ActiveWorkbook.Save
                          ActiveWorkbook.Close
                      End If
                      
                  End If
                  
              Next c
              
              End Sub

              Là je l'ai replacé de façon à mettre la valeur uniquement dans les fichiers créés (ne s'execute pas si le fichier existe déjà) mais on peut encore "déplacer"....
              0
              1. Re à vous deux,

                C'est parfait !!!!!

                Si je me concidère comme l'élève et vous comme les formateurs, le temps ou l'élève dépassera ses formateurs est encore loin devant moi...

                Merci encore
                0