Création d'un fichier à partir d'une liste

Le 08/12/2021 à 16:57

Bonjour à tous,

J'aimerai solliciter votre aide,

mon sujet est le suivant:

j'ai un fichier Excel (pièce jointe) qui contient des lignes des travaux à réaliser,

est-il possible avec VBA de créer un bouton qui va créer des fichier excel qui porteront les informations suivantes:

Fichier 1 :

Cellule F11 : Description intervention qui est sur la colonne B de la ligne 1

Cellule R15 : Le numéro qui est dans la colonne A de la ligne 1

Cellule F9 : Contenu de la colonne I de la ligne 1

Cellule F10 :Contenu de la colonne J de la ligne 1

exemple :

appuyer sur un bouton pour créer un fichier excel :

et par la suite, se fichier excel sera enregistré dans un dossier via un chemin déjà créé qui porte déjà le N° .

Merci beaucoup

11prev.xlsx (16.33 Ko)
Le 08/12/2021 à 17:24

Bonjour Imad,

Le fichier créé n'aura que ces infos ?

Voici un premier essai en tout cas avec l'enregistrement en attente :

sub test()
tSrc = array("B1", "A1", "I1", "J1")
tDest = array("F11", "R15", "F9", "F10")
with workbooks.add
    with .sheets(1)
        .name = "NOMWS"
        for i = lbound(tDest) to ubound(tDest)
            .range(tDest(i)).value = thisworkbook.activesheet.range(tSrc(i)).value
        next i
    end with
    'sfilename = "???"
    '.saveas sfilename, xlOpenXMLWorkbook
    '.close true
end with
end sub

Cdlt,

Edit : Salut Bruno

Le 08/12/2021 à 17:25

Bonjour Imad SIO

Vous allez dire que je vous en veux, mais je vous assure que ce n'est absolument pas le cas

Si vous utilisez l'enregistreur de macros et effectuez les actions demandées, cela vous donnera un code tout à fait exploitable

A ce moment là, joignez-nous le fichier anonymisé avec code créé et nous vous aiderons

Cordialement.

Edit salut 3GB trop gentil, merci

Le 08/12/2021 à 17:35

Bonsoir tout le monde,

Comme j'avais commencé quelque chose, je poste un début de réponse avec un code assez basique....

@3GB : c'est toujours un plaisir (et un peu de frustration) de lire tes codes, 

Sub créer_fiches()
 Dim i%, dl%
  With Sheets("Préventif programmé")
   dl = .Range("A" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
     For i = 3 To dl
      If .Range("A" & i) <> "" Then
       Sheets("Permis").Copy after:=Sheets(Sheets.Count)
       ActiveSheet.Name = .Range("A" & i)
       ActiveSheet.Range("F9") = .Range("I" & i)
       ActiveSheet.Range("F10") = .Range("J" & i)
       ActiveSheet.Range("F11") = .Range("B" & i)
       ActiveSheet.Range("R15") = .Range("A" & i)
      End If
     Next i
  End With
End Sub

Les feuilles sont crées dans le classeur source...

CTRL + e pour lancer la macro...

15imad-sio.xlsm (20.58 Ko)

Cordialement,

Le 08/12/2021 à 18:36

Merci XORSANKUKAI,

le code fonctionne à merveille,

je l'ai ajusté pour pouvoir extraire les onglets créés sur un autre dossier,

un grand merci

Le 08/12/2021 à 19:28

Re,

Merci pour le retour,

je l'ai ajusté pour pouvoir extraire les onglets créés sur un autre dossier

Peut-être peux-tu poster ton code, afin d'en faire profiter le forum...

Cordialement,

Le 08/12/2021 à 19:36

Voici le code complet :

Sub créer_fiches()
 Dim i%, dl%
  With Sheets("Préventif programmé")
   dl = .Range("A" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
     For i = 3 To dl
      If .Range("A" & i) <> "" Then
       Sheets("Permis").Copy after:=Sheets(Sheets.Count)
       ActiveSheet.Name = .Range("A" & i)
       ActiveSheet.Range("F9") = .Range("I" & i)
       ActiveSheet.Range("F10") = .Range("J" & i)
       ActiveSheet.Range("F11") = .Range("B" & i)
       ActiveSheet.Range("R15") = .Range("A" & i)
      End If
     Next i
  End With

  'Extraire les onglets'
  For Each sh In ActiveWorkbook.Sheets
  sh.Copy
  ActiveWorkbook.SaveAs "D:\preventifs" & sh.Name
  ActiveWorkbook.Close
  Next

End Sub

Est-il possible de modifier le code pour renommer les onglets, je souhaite les renommer de la façon suivante :

Permis Général Préventif N° (contenu de la cellule R15)

merci

Le 08/12/2021 à 20:51

Re,

J'en était resté là dans ma réflexion.......

Sub créer_fiches()
 Dim i%, dl%
 Dim NWBK As Workbook

 Application.ScreenUpdating = False

  With Sheets("Préventif programmé")
   dl = .Range("A" & Rows.Count).End(xlUp).Row
     For i = 3 To dl
      If .Range("A" & i) <> "" Then
       ThisWorkbook.Sheets("Permis").Copy: Set NWBK = ActiveWorkbook
       ActiveSheet.Name = .Range("A" & i)
       ActiveSheet.Range("F9") = .Range("I" & i)
       ActiveSheet.Range("F10") = .Range("J" & i)
       ActiveSheet.Range("F11") = .Range("B" & i)
       ActiveSheet.Range("R15") = .Range("A" & i)
       NWBK.SaveAs "C:\Users\maison\Desktop\Nouveau dossier\" & "Permis Général Préventif N°" & NWBK.Sheets(1).Name & ".xlsx", FileFormat:=51: NWBK.Close true
      End If
     Next i
  End With
End Sub

Mais ça mouline un peu, il doit y avoir moyen d'optimiser....

Il faut adapter le chemin :

"C:\Users\maison\Desktop\Nouveau dossier\"

Cordialement,

Le 08/12/2021 à 21:06

ça marche à merveille

merci beaucoup

Le 09/12/2021 à 10:59

Bonjour xorsankukai,

j'aimerai ajuster ma macro pour que l’enregistrement des nouveaux fichiers créés se fera dans les dossiers spécifiques,

c'est à dire : je veux enregistrer le Permis Général Préventifs 001 dans un dossier qui s'appelle Préventif N°001, et c'est la même chose pour tous les fichiers

Tous les dossiers sont déjà crée et stocké dans le même répertoire.

est-ce que c'est possible.

merci d'avance

Le 09/12/2021 à 13:53

Re,

je veux enregistrer le Permis Général Préventifs 001 dans un dossier qui s'appelle Préventif N°001, et c'est la même chose pour tous les fichiers

Tous les dossiers sont déjà crées

A tester...

Sub créer_fiches()
 Dim i%, dl%
 Dim WbkSource As Workbook, NWBK As Workbook

 Application.ScreenUpdating = False
  Set WbkSource = ThisWorkbook
   With WbkSource.Sheets("Préventif programmé")
    dl = .Range("A" & Rows.Count).End(xlUp).Row
     For i = 3 To dl
      If .Range("A" & i) <> "" Then
       WbkSource.Sheets("Permis").Copy: Set NWBK = ActiveWorkbook
       ActiveSheet.Name = .Range("A" & i): dossier = "Préventif N°" & .Range("A" & i) & "\"
       ActiveSheet.Range("F9") = .Range("I" & i)
       ActiveSheet.Range("F10") = .Range("J" & i)
       ActiveSheet.Range("F11") = .Range("B" & i)
       ActiveSheet.Range("R15") = .Range("A" & i)
       NWBK.SaveAs "C:\Users\maison\Desktop\Nouveau dossier\" & dossier & "Permis Général Préventif N°" & _
       NWBK.Sheets(1).Name & ".xlsx", FileFormat:=51: NWBK.Close True
      End If
     Next i
   End With
End Sub

Chemin à adapter:

"C:\Users\maison\Desktop\Nouveau dossier\"

Cordialement,

Le 09/12/2021 à 14:28

ça réponds parfaitement à mon besoin,

je te remercie infiniment.

j'aurai aimé que l'onglet créé dans le fichier portera même nom que son fichier

mais ce n'est pas grave

jusqu'à là c’est parfait

merci encore une fois

Le 09/12/2021 à 14:45

Re,

j'aurai aimé que l'onglet créé dans le fichier portera même nom que son fichier

C'est à dire ?

Sub créer_fiches()
 Dim i%, dl%
 Dim WbkSource As Workbook, NWBK As Workbook

 Application.ScreenUpdating = False
  Set WbkSource = ThisWorkbook
   With WbkSource.Sheets("Préventif programmé")
    dl = .Range("A" & Rows.Count).End(xlUp).Row
     For i = 3 To dl
      If .Range("A" & i) <> "" Then
       WbkSource.Sheets("Permis").Copy: Set NWBK = ActiveWorkbook
       ActiveSheet.Name = "Permis Général Préventif N°" & .Range("A" & i): dossier = "Préventif N°" & .Range("A" & i) & "\"
       ActiveSheet.Range("F9") = .Range("I" & i)
       ActiveSheet.Range("F10") = .Range("J" & i)
       ActiveSheet.Range("F11") = .Range("B" & i)
       ActiveSheet.Range("R15") = .Range("A" & i)
       NWBK.SaveAs "C:\Users\maison\Desktop\Nouveau dossier\" & dossier & _
       NWBK.Sheets(1).Name & ".xlsx", FileFormat:=51: NWBK.Close True
      End If
     Next i
   End With
End Sub


Cordialement,

Rechercher des sujets similaires à "creation fichier partir liste"