Incrémenter une formule

Bonjour, je dois copier le contenu de certaines cellules situées sur la ligne 1 du fichier X et les coller dans un nouvel onglet du fichier Y sur la ligne 1.
Ensuite, il faut retourner dans le fichier X et copier les cellules de la ligne 2 et les coller dans un nouvel onglet du fichier Y et ainsi de suite jusqu'à la ligne 400 du fichier X.
À la fin du processus, le fichier Y contiendra 400 onglets.

Comment créer la macro qui incrémentera de 1 ligne à chaque fois et qui crée le nouvel onglet à chaque fois dans le fichier Y.

Merci de votre aide!

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22

Dim wbk As Workbook Dim asht As Worksheet, sht As Worksheet Dim LastLig As Long, i As Long   Application.ScreenUpdating = False Set asht = ThisWorkbook.Sheets("Feuil1") Set wbk = Workbooks.Add(1) With asht LastLig = .Cells(Rows.Count, 1).End(xlUp).Row For i = 1 To LastLig Set sht = wbk.Worksheets.Add(after:=wbk.Sheets(wbk.Sheets.Count)) .Rows(i).Copy sht.Range("A1") Next i End With Set asht = Nothing Set sht = Nothing Application.DisplayAlerts = False wbk.Sheets(1).Delete Application.DisplayAlerts = False wbk.SaveAs ThisWorkbook.Path & "\FichierResultat" wbk.Close Set wbk = Nothing

---

Bonjour Mercatog,
mon fichier contient environ 1500 lignes mais je ne souhaite que prendre les 400 premières lignes.
Quelle sera alors la nouvelle nomenclature de la ligne vba

Code:

---

LastLig = .Cells(Rows.Count, 1).End(xlUp).Row

---

que tu me propose dans ta soluce?

Merci

simplement, remplace dans cette partie

Code:

---

1 2 3 4 5 6

With asht For i = 1 To 400 Set sht = wbk.Worksheets.Add(after:=wbk.Sheets(wbk.Sheets.Count)) .Rows(i).Copy sht.Range("A1") Next i End With

---

Salut mercatog,
J'ai essayé ta proposition sur une partie de mon projet et ça fonctionne comme je le voulais:merci:. Avant de clore le dossier, je vais tenter de réunir l'ensemble des opérations voulues et je t'aviserai si tout a réussi ou si j'ai encore besoin de ton aide. Merci beaucoup de ta précieuse collaboration :ccool:

Hmmm.... j'ai été un peu trop entousiaste....:no: C'est un peu plus complexe que je croyais de mettre tout ça bout à bout pour obtenir le produit fini. En plus, j'ai mal exprimée ma demande initiale:marteau:
Je reprend donc du tout début:

Le nouvel onglet à ouvrir est dans un fichier existant ("Archive.xls"), un onglet gabarit nommé "Fiche" s'y trouve et doit être dupliqué avant de coller les cellules copiées auparavant dans le fichier X.

Donc, en résumé: je copie le contenu des cellules de la ligne 1 du fichier X, je duplique l'onglet "fiche" du fichier Archive.xls, colle les infos dans le nouvel onglet "Fiche(2) et recommence les opérations à la ligne 2 et ainsi de suite jusqu'à la ligne 400.
L'onglet gabarit nommé "Fiche" aura donc été dupliqué 400 fois à la fin de l'opération.

Désolé du contretemps que j'ai pu te causer mercatog....:oops:

Je m'attendais à des questions sur le code. je me demande si tu as essayé de comprendre.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19

Dim wbk As Workbook Dim asht As Worksheet, sht As Worksheet Dim i As Long   Application.ScreenUpdating = False Set asht = ThisWorkbook.Sheets("Feuil1") Set wbk = Workbooks.Open("C:\Documents and Settings\Administrateur\Bureau\Archives.xls") With asht For i = 1 To 400 wbk.Worksheets("Fiche").Copy After:=wbk.Sheets(wbk.Sheets.Count) Set sht = ActiveSheet sht.Range("A1:Z1").Value = .Range("A1:Z1").Value Next i End With Set sht = Nothing Set asht = Nothing wbk.Save wbk.Close Set wbk = Nothing

---

Bonjour mercatog,

J'ai adapté ta solution à ma macro (jai utilisé l'instruction For i = 1 To LastLig
finalement) et tout fonctionne à merveille mais à l'occasion,dans certains fichiers, tout s'arrête et l'erreur 400 apparait.

Peut-être est-ce dû au trop grand nombre de feuilles contenues dans ces fichiers créés. Afin d'éviter cette situation, j'aimerais plutôt enregistrer individuellement la feuille qui est créée, à chacune des boucle du FOR, sur le disque D, avec pour nom, le texte contenu à la cellule A1 de cette feuille.

Une fois enregistrée, cette feuille serait "rafraichit" par le contenu des informations de la ligne 2 et ainsi de suite.
Que me proposes-tu?

Encore une fois, merci de ton aide!

Avec le code ci-dessous, j'ai réussi à enregistrer le fichier avec un nom que je dois lui donner manuellement via le inputbox.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20

Sub Enregistrer_Feuille()   With asht LastLig = .Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To LastLig wbk.Worksheets("dossier").Copy 'After:=wbk.Sheets(wbk.Sheets.Count) Set sht = ActiveSheet .Rows(i).Copy sht.Range("A60"): Call Copie_Champs(sht) 'Copie la valeur de certaines cellules aux emplacements voulus sur la nouvelle feuille   With ActiveWorkbook .SaveAs "D:\Documents and Settings\Bureau\Mes documents\SCM_LA1\" & _ InputBox("ENTREZ LE NOM DU FICHIER...", "Feuille enregistrée sous...") & ".xls" .Close Set wbk = Workbooks.Open("D:\Documents and Settings\Bureau\Mes documents\SCM_LA1\Dossier_LA1.xls") End With   Next i End With   End Sub

---

Mais c'est pas l'idéal car il y a trop de fichiers à enregistrer. Je voudrais plutot que le fichier porte le nom de la cellule A1 de la feuille active. J'ai essayé avec le code ci-dessous mais ça me donne toujours comme nom de fichier: CENTR..xls peu importe le contenu de la cellule A1.

Code:

---

1 2 3 4 5 6 7

With ActiveWorkbook .SaveAs Filename:="D:\Documents and Settings\Bureau\Mes documents\SCM_LA1\" & Range("a1") & ".xls", FileFormat:= _ xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _ , CreateBackup:=False .Close Set wbk = Workbooks.Open("D:\Documents and Settings\Bureau\Mes documents\SCM_LA1\Dossier_LA1.xls") End With

---

Qu'est-ce qui empêche de le code de fonctionner correctement? Y a-t-il des variables à configurer?
Merci de m'aider!

(Note: je travaille avec excel 2002)

:resolu:
Finalement j'ai trouvé ce qui ne marchait pas.
Je devais spécifier à partir de quelle feuille copier le contenu de A1.
Donc, en ajoutant ' .... sht.Range("a1") dans le code, tout a fonctionné correctement.

Le bon code est donc (roulement de tambour):

Code:

---

1 2 3 4 5 6 7 8

Set sht = ActiveSheet With ActiveWorkbook .SaveAs Filename:="D:\Documents and Settings\Bureau\Mes documents\SCM_LA1\" & sht.Range("a1") & ".xls", FileFormat:= _ xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _ , CreateBackup:=False .Close Set wbk = Workbooks.Open("D:\Documents and Settings\Bureau\Mes documents\SCM_LA1\Dossier_LA1.xls") End With

---

Salutations les plus cordiales ! :ccool: