Boucle pour creer fiche client

Le 19/03/2014 à 19:58

Bonjour a tous, j'ai besoin d'aide pour creer un boucle

j'a un classeur excel avec tous mes client ligne par ligne.

Le but est de creer une fiche client pour chaque ligne. (soit environ 450 lignes)

pour ne pas le faire manuelement j'ai deja creer le SUB pour copier une ligne des mon classeur, et des les copier dans un nouveau classeur ''fiche client" et l'enregistrer automatiquement au nom d'apres une celulle.

je voudrais savoir comment faire pour faire une boucle pour chaque ligne des mon premier classeur et creeer autan de fiche client que de ligne.

Voici mon code pour copier la les celule de la ligne 2 de mon classeur '' ETS FIGUET COMPLET" dans un classeur 2 ''fiche client " puis l'enregistrer sous le nom de la celule du nom client '' B2 "

Merci d'avance.

Sub ficheclient3()

'

' ficheclient3 Macro

'

'

Windows("logiciel ETS FIGUET COMPLET.xlsm").Activate

Range("A2").Select

Selection.Copy

Windows("FICHE CLIENT.xlsm").Activate

Range("B1").Select

ActiveSheet.Paste

Windows("logiciel ETS FIGUET COMPLET.xlsm").Activate

Range("B2").Select

Application.CutCopyMode = False

Selection.Copy

Windows("FICHE CLIENT.xlsm").Activate

Range("B2").Select

ActiveSheet.Paste

Windows("logiciel ETS FIGUET COMPLET.xlsm").Activate

Range("C2").Select

Application.CutCopyMode = False

Selection.Copy

Windows("FICHE CLIENT.xlsm").Activate

Range("B3").Select

ActiveSheet.Paste

Windows("logiciel ETS FIGUET COMPLET.xlsm").Activate

Range("D2").Select

Application.CutCopyMode = False

Selection.Copy

Windows("FICHE CLIENT.xlsm").Activate

Range("B4").Select

ActiveSheet.Paste

Windows("logiciel ETS FIGUET COMPLET.xlsm").Activate

Range("E2").Select

Application.CutCopyMode = False

Selection.Copy

Windows("FICHE CLIENT.xlsm").Activate

Range("B5").Select

ActiveSheet.Paste

Windows("logiciel ETS FIGUET COMPLET.xlsm").Activate

Range("F2").Select

Application.CutCopyMode = False

Selection.Copy

Windows("FICHE CLIENT.xlsm").Activate

Range("B6").Select

ActiveSheet.Paste

Windows("logiciel ETS FIGUET COMPLET.xlsm").Activate

Range("G2").Select

Application.CutCopyMode = False

Selection.Copy

Windows("FICHE CLIENT.xlsm").Activate

Range("B7").Select

ActiveSheet.Paste

Windows("logiciel ETS FIGUET COMPLET.xlsm").Activate

ActiveWindow.SmallScroll ToRight:=7

Range("H2").Select

Application.CutCopyMode = False

Selection.Copy

Windows("FICHE CLIENT.xlsm").Activate

Range("B8").Select

ActiveSheet.Paste

Windows("logiciel ETS FIGUET COMPLET.xlsm").Activate

Range("I2").Select

Application.CutCopyMode = False

Selection.Copy

Windows("FICHE CLIENT.xlsm").Activate

Range("B9").Select

ActiveSheet.Paste

Windows("logiciel ETS FIGUET COMPLET.xlsm").Activate

Range("J2").Select

Application.CutCopyMode = False

Selection.Copy

Windows("FICHE CLIENT.xlsm").Activate

Range("B10").Select

ActiveSheet.Paste

Windows("logiciel ETS FIGUET COMPLET.xlsm").Activate

Range("K2").Select

Application.CutCopyMode = False

Selection.Copy

Windows("FICHE CLIENT.xlsm").Activate

Range("B11").Select

ActiveSheet.Paste

Windows("logiciel ETS FIGUET COMPLET.xlsm").Activate

Range("L2").Select

Application.CutCopyMode = False

Selection.Copy

Windows("FICHE CLIENT.xlsm").Activate

Range("B12").Select

ActiveSheet.Paste

Windows("logiciel ETS FIGUET COMPLET.xlsm").Activate

Range("M2").Select

Application.CutCopyMode = False

Selection.Copy

Windows("FICHE CLIENT.xlsm").Activate

Range("B13").Select

ActiveSheet.Paste

Windows("logiciel ETS FIGUET COMPLET.xlsm").Activate

Range("N2").Select

Application.CutCopyMode = False

Selection.Copy

Windows("FICHE CLIENT.xlsm").Activate

Range("B14").Select

ActiveSheet.Paste

Dim nom As String

ChDir "C:\Users\utilisateur\Dropbox\bureau ludo\Dossiers Ludo\macro"

nom = Range("B2") & ".xlsm"

ThisWorkbook.SaveAs (nom)

End Sub

Le 19/03/2014 à 21:17

Bonsoir

Sans aucun test

Option Explicit

Sub CreationFichiers()
Dim Ws As Worksheet
Dim J As Long, NbLg As Long
Dim Chemin As String
Dim NbFeuille As Integer

  Application.ScreenUpdating = False
  'Chemin = "C:\Users\utilisateur\Dropbox\bureau ludo\Dossiers Ludo\macro\"
  Chemin = ThisWorkbook.Path & Application.PathSeparator
  NbFeuille = Application.SheetsInNewWorkbook
  Set Ws = Sheets("Feuil1")       ' Nom de la feuille contenant la liste
  NbLg = Ws.Range("B" & Rows.Count).End(xlUp).Row
  Application.SheetsInNewWorkbook = 1
  Application.DisplayAlerts = False     ' Ecrase l'éventuel ancien fichier sans demande
  For J = 2 To NbLg
    With Workbooks.Add
      .Sheets(1).Name = Ws.Range("B" & J)
      Ws.Range("A" & J & ":N" & J).Copy
      .Sheets(1).Range("B1").PasteSpecial Paste:=xlPasteAll, Transpose:=True
      .SaveAs Filename:=Chemin & Ws.Range("B" & J) & ".xlsm", FileFormat:=xlOpenXMLWorkbook
      .Close
    End With
  Next J
  Application.CutCopyMode = False
  Application.SheetsInNewWorkbook = NbFeuille
  MsgBox "Terminé"
End Sub

Il faudrait ton fichier principal et 1 fichier obtenu (avec la copie des cellules)

Le 19/03/2014 à 21:22

bonjour Banzai64, ludo1717

ludo1717, ton code je pense que tu peux le réduire comme ci dessous

Sub ficheclient3()
'
' ficheclient3 Macro
'

'
Windows("logiciel ETS FIGUET COMPLET.xlsm").Range("A2:N2").copy
Windows("FICHE CLIENT.xlsm").Range("B1:B14").Paste

Dim nom As String
ChDir "C:\Users\utilisateur\Dropbox\bureau ludo\Dossiers Ludo\macro"
nom = Range("B2") & ".xlsm"
ThisWorkbook.SaveAs (nom)

End Sub

clic sur le bouton code pour que ton code soit encadré et plus lisible

Pascal

Le 20/03/2014 à 09:28

Re bonjour a tous

j'ai modifier mon code d'apres BANZAI car c vrai qu il est vraiment pus simple.

Je modifi aussi ma demande car je prefere avoir un classeur "fiche client" et chaque feuille de ce classeur corresponde a chaque ligne de mon classeur ETS FIGUET COM¨PLET.

Voici mon code avec la boucle 'manuele que j'ai faite.

il me faudrai un boucle automatique pour mes 450 ligne de mon classeur ETS FIGUET COMPLET. merci d'avance

Sub ficheclient5()

'

' ficheclient5 Macro

'

Windows("logiciel ETS FIGUET COMPLET.xlsm").Activate

    Range("A1:O1").Select
    Selection.Copy
    Windows("FICHE CLIENT.xlsm").Activate
    Sheets("Feuil1").Select
    Range("A1").Select
    ActiveSheet.Paste
    Windows("logiciel ETS FIGUET COMPLET.xlsm").Activate
    ActiveWindow.SmallScroll ToRight:=-8
    Range("A2:O2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("FICHE CLIENT.xlsm").Activate
    Range("A2").Select
    ActiveSheet.Paste
    ActiveSheet.Name = Range("B2").Text

    'boucle....'

    Sheets("Feuil2").Select ' du classeur fiche client'

    Windows("logiciel ETS FIGUET COMPLET.xlsm").Activate
    Range("A1:O1").Select
    Range("O1").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("FICHE CLIENT.xlsm").Activate
    Range("A1").Select
    ActiveSheet.Paste
    Windows("logiciel ETS FIGUET COMPLET.xlsm").Activate
    Range("A3:O3").Select ' ligne 3 du classeur ETS FIGUET COMPLET'

    Application.CutCopyMode = False
    Selection.Copy
    Windows("FICHE CLIENT.xlsm").Activate
    Range("A2").Select
    ActiveSheet.Paste
     ActiveSheet.Name = Range("B2").Text

     'boucle'
     Sheets("Feuil3").Select ' du classeur fiche client'

    Windows("logiciel ETS FIGUET COMPLET.xlsm").Activate
    Range("A1:O1").Select

    Application.CutCopyMode = False
    Selection.Copy
    Windows("FICHE CLIENT.xlsm").Activate

    Range("A1").Select
    ActiveSheet.Paste
    Windows("logiciel ETS FIGUET COMPLET.xlsm").Activate
    Range("A4:O4").Select ' ligne 3 du classeur ETS FIGUET COMPLET'

    Application.CutCopyMode = False
    Selection.Copy
    Windows("FICHE CLIENT.xlsm").Activate
    Range("A2").Select
    ActiveSheet.Paste
     ActiveSheet.Name = Range("B2").Text
End Sub
Le 20/03/2014 à 11:31

Bonjour

J'ai du mal comprendre

Tu veux créer un seul fichier avec 450 feuilles ou 450 fichiers d'une seule feuille (la macro que je t'ai faite)

Si la liste des feuilles(fichiers) est en colonne B, pourquoi choisir B2 pour le nom du fichier ?

Joins le fichier principal en y indiquant exactement ce que tu veux obtenir

Un exemple de ce que veux obtenir serait un plus non négligeable

Le 20/03/2014 à 12:16

Je veux faire un seul classeur nommée fiche client . Et 450 feuille dans ce classeur. Une feuille pour chaque nom. Je refait le code cet aprem en plus simple et je l envois en fichier joint.

Le 20/03/2014 à 15:14

Re bonjour

j'ai modifier ma demande ainsi que mon code pour que ce soit plus simple pour que vous puissiez m'aider.

Donc 1 classeur ''FICHE CLIENT'' :

dans la feuille 1, ma liste de clients, avec nom prenom adresse ....

et le but est de faire pour chaque ligne de ma feuille 1, creer une feuille pour chaque lignes.

j'ai deja fait le code pour faire 3 feuille mais ca prend du temps de tous réecrir en modifiant le code, donc il me faudrait une boucle pour faire cette opération : Copier ligne 1 et 2 de feuil1, puis creer feuil2 et coller dans ligne 1 et 2 de feuil 2 --- Copier ligne 1 et 3 de feuil1, puis creer feuil3 et coller dans ligne 1 et 2 de feuil3 --- Copier ligne 1 et 4 de feuil1, puis creer feuil4 et coller dans ligne 1 et 2 de feuil 4 --- ... et ainsi de suite.

Ci joint umon fichier avec la macro que j'ai faite pour 3 nouvelle feuille, mais en recopian le code et le modifier pour chaque feuil.

il me faudrai une boucle pour faire tous ca autaumatiquement.

Pour faire l'essai faire CTRL+m

69fiche-client-essais.xlsm (77.00 Ko)
Le 20/03/2014 à 15:47

Bonjour

A tester

Laisse lui le temps

112ludo1717-creation-feuilles-v001.xlsm (153.61 Ko)
Rechercher des sujets similaires à "boucle creer fiche client"