Discussion :

[HQ_LG4]

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!

[mercatog]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[HQ_LG4]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

que tu me propose dans ta soluce?

Merci

[mercatog]

simplement, remplace dans cette partie

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[HQ_LG4]

Salut mercatog,
J'ai essayé ta proposition sur une partie de mon projet et ça fonctionne comme je le voulais. 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

[HQ_LG4]

Hmmm.... j'ai été un peu trop entousiaste.... 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
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....

[mercatog]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[HQ_LG4]

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!

[HQ_LG4]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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)

[HQ_LG4]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 !