Copie de feuilles

[Pyrof]

Bonjour,

J'ai écrit la macro suivante :

Private Sub xxxx()
For Each feuille In Worksheets
tmp = feuille.Name
If InStr(tmp, "Poste_") = 1 And Len(tmp) > 6 Then
delete_sheet feuille.Name
End If
Next
For poste_ref = 1 To 10
nb = Sheets.Count
Worksheets("Poste base").Copy After:=Worksheets(1)
Sheets(nb + 1).Select
ActiveSheet.Name = "Poste_" & poste_ref
Next
End Sub

elle est censée supprimer toutes les feuilles dans le nom commence pae Poste_ et va copie la feuille "Poste base" en Poste_1 Pose_2 .....

Si je l'exécute la première fois ça fonctionne. Mais dès que je l'éxécute plusieurs fois j'ai le message

La méthode Copy de la classe Worksheet a échoué

Si j'enregistre le fichier, je quitte excel, j'ouvre à nouveau le fichier, ça fonctionne uniquement à la première exécution.

Avez vous eu ce problème
Pour info je travaille avec la version 2003
Merci

 

[ninbihan]

Re : Copie de feuilles

Bonjour,

J'ai essayé de recréer ton pb. Voic une macro qui semble fonctionner:

Private Sub test()
For Each feuille In Worksheets
If Left(feuille.Name, 6) = "Poste_" Then
Application.DisplayAlerts = False
feuille.Delete
Application.DisplayAlerts = True
End If
Next
For poste_ref = 1 To 10
nb = Sheets.Count
Worksheets("Poste base").Copy After:=Worksheets(poste_ref)
Sheets(nb + 1).Name = "Poste_" & poste_ref
Next
End Sub

Bon aprés midi,

Ninbihan

 

[Pyrof]

Re : Copie de feuilles

Avec la petite modif (en gras), ça bug à la 3 eme exécution


Private Sub test()
For Each feuille In Worksheets
If Left(feuille.Name, 6) = "Poste_" Then
Application.DisplayAlerts = False
feuille.Delete
Application.DisplayAlerts = True
End If
Next
For poste_ref = 1 To 10
nb = Sheets.Count
Worksheets("Poste base").Copy After:=Worksheets(poste_ref)
ActiveSheet.Name = "Poste_" & poste_ref
Next
End Sub


Mon but est de copier la feuille "Poste base" en feuille nommée Poste1_ à x
Dans l'exemple à 10, mais ceci sera variable.

A chaque exécution le macro je veux détruire toutes les feuiles "Poste_xx" et les ré-créer.

Merci

 

[ninbihan]

Re : Copie de feuilles

Re,

Un nouvel essai avec une variable tableau qui enregistre tous les noms des feuilles supprimées... A tester

Private Sub test2()

Dim Post_ref() As String
ReDim Post_ref(0)
For Each feuille In Worksheets
    If Left(feuille.Name, 6) = "Poste_" Then
        Application.DisplayAlerts = False
        ReDim Preserve Post_ref(1 + UBound(Post_ref))
        Post_ref(UBound(Post_ref)) = feuille.Name
        feuille.Delete
        Application.DisplayAlerts = True
    End If
Next
For i = 1 To UBound(Post_ref)
    nb = Sheets.Count
    Worksheets("Poste base").Copy After:=Worksheets(nb)
    Sheets(nb + 1).Name = Post_ref(i)
Next

End Sub

Bonne fin d'aprés midi,

Ninbihan

 

[Pyrof]

Re : Copie de feuilles

Bonjour,

Pour plus de clarté je joins le fichier (réduit au minimum)

si on exécute consécutivement plusieurs fois la macro on a un plantage

Il plante sur la copie de la feuille


erci

 

[ninbihan]

Re : Copie de feuilles

Bonjour Pyrof,

J'ai trouvé cela dans la kb MS Copying worksheet programmatically causes run-time error 1004 in Excel
Donc d'aprés cet article, il faut soit quitter le classeur ou copier à partir d'un xlt


Bon WE,

Ninbihan

 

[Pyrof]

Re : Copie de feuilles

Bonjour ninbihan,

Grand merci, c'est exactement le problème, je vais tester l'enregistrement intermédiaire

Encore merci

 

[Pyrof]

Re : Copie de feuilles

Re bonjour,

En fête j'ai pris l'option d'enregistrer ma feuille modèle en fichier xlt et ensuite, j'ajoute les feuilles suivant ce fichier xlt.

ça fonctionne très bien

Merci

Voici pour ceux que ça intéresse la routine pour sauvegarder une feuille en fichier xlt

Sub create_fichier_modele()
Application.DisplayAlerts = False
    fic_mod = "Modele_poste.xlt" ' nom du fichier xlt
    feuille_modele = "Poste base" ' nom de la feuille du classeur
    
    rep = ThisWorkbook.Path
    fic_trav = ThisWorkbook.Name
    Workbooks.Add
    ActiveWorkbook.SaveAs Filename:=rep & Application.PathSeparator & fic_mod, _
    FileFormat:=xlTemplate, Password:="", WriteResPassword:="", _
    ReadOnlyRecommended:=False, CreateBackup:=False
    
    Workbooks(fic_trav).Sheets(feuille_modele).Copy Before:=Workbooks(fic_mod).Sheets(1)
    Sheets(Array("Feuil1", "Feuil2", "Feuil3")).Select
    ActiveWindow.SelectedSheets.Delete
    
    ActiveWorkbook.Save
    ActiveWindow.Close
Application.DisplayAlerts = True
'pour inserer la sheet:
'Sheets.Add type:=ThisWorkbook.Path & Application.PathSeparator & fic_mod, after:=Sheets(xx)
End Sub