empecher doublons de feuilles

gregouille · 21 Septembre 2006

j'ai une macro qui me créer des feuilles par rapport a une liste donnée qui se situe entre A10 et A32 inclus
supposons que j'execute la macro pour qu'elle me creer les feuilles et qu'ensuite je m'appercoive que j'ai oublié une ligne, quand je re-éxécute la macro elle va me créer les feuilles deja faite

donc ce que je voudrais c'est intégrer une ligne dans la macro qui :
- soit évite les doublons et ne créer pas la feuille si elle y est deja
ou
- qu'elle m'éfface les feuilles deja créer auparavant pour ensuite ma les recréer comme avant

PS: j'ai une petite preference pour la première solution

j'ai bien une idée de comment faire mais je sais pas lui dire en VBA

Sub Transfert()
'Macro par DAN pour Gregouille le 19/09/2006
'Fil : Lien supprimé
Dim i As Byte, lig As Integer, ligne As Integer
Application.ScreenUpdating = False
On Error Resume Next
lig = Sheets("Tableau").Range("A32").Row
For i = 10 To lig
If Sheets("Tableau").Range("A" & i).Value = 0 Then _
Sheets("mod_fich").Visible = False: End
With Sheets("mod_fich")
.Visible = True
.Copy after:=Worksheets(Worksheets.Count)
End With
ActiveSheet.Name = "fich_" & i - 9
With ActiveSheet
.Cells(3, 9) = Sheets("Tableau").Cells(i, 1).Value
.Cells(5, 9) = Sheets("Tableau").Cells(i, 2).Value
.Cells(6, 5) = Sheets("Tableau").Cells(i, 13).Value
.Cells(42, 9) = Sheets("Tableau").Cells(i, 10).Value
.Cells(13, 2) = Sheets("Tableau").Cells(i, 14).Value
.Cells(2, 9) = "num_" & i - 9
.Cells(4, 8) = Sheets("Tableau").Cells(3, 10).Value
End With
Next i
Application.ScreenUpdating = True
End Sub

voila ma macro que DAN m'a concocté
merci d'avance pour votre aide

nat54 · 21 Septembre 2006

Re : empecher doublons de feuilles

Bonjour,

J'avais eu le même souci en stage

Si tes onglets sont toujours nommés de la même manière, tu peux faire
- 1 macro pour supprimer les onglets A/B/C
- ta macro de création

gregouille · 21 Septembre 2006

Re : empecher doublons de feuilles

le souci c'est que a part en mode enregistrement les macro c'est pas trop mon fort dans excel

nat54 · 21 Septembre 2006

Re : empecher doublons de feuilles

Bonjour,

Justement là la macro d'enregistrement suffit

1° Lance ta macro de création
donc tu as tes onglets

2° Lance enregistreur de macro
supprime les onglets voulus
puis affecte la macro à un bouton

gregouille · 21 Septembre 2006

Re : empecher doublons de feuilles

jusque là je suis d'accord avec toi mais en fait mon tableau varie en fonction des semaines (c'est un tableau recapitulatif des interventions effectuées)

donc il y a des semaines ou j'en ferai 0 et d'autre 5
ce tableau est remplie en théorie au fur et a mesure qu'on fait une intervention mais il se peut qu'on en oublie une donc on la rajoute en bas et si je re-éxécute la macro pour créer la fiche par rapport a la ligne que je vien de rajouter elle vas me recréer les autres sous un autre nom

si tu veux je peux mettre le tableau en lien pour que tu puisse voir comment ca fait

porcinet82 · 21 Septembre 2006

Re : empecher doublons de feuilles

Salut,

A mon avis je me suis un peu embrouiller pour rien, mais le peu de tests que j'ai effectués avait l'air de fonctionner, donc je te laisse le soin de me donner ton avis :

Code:

Sub Transfert_v2()
'Macro par DAN pour Gregouille le 19/09/2006
'Fil : [B]Lien supprimé[/B]
Dim i As Byte, lig As Integer, ligne As Integer
Dim ws As Worksheet, bool As Boolean
Application.ScreenUpdating = False
On Error Resume Next
lig = Sheets("Tableau").Range("A32").Row
For i = 10 To lig
    If Sheets("Tableau").Range("A" & i).Value = 0 Then Sheets("mod_fich").Visible = False: End
        With Sheets("mod_fich")
            .Visible = True
            .Copy after:=Worksheets(Worksheets.Count)
        End With
        For Each ws In Worksheets
            a = ws.Name
            If ws.Name = "fich-" & i - 9 Then bool = True
        Next ws
        If bool = True Then
            Application.DisplayAlerts = False
            Sheets(Sheets.Count).Delete
            Application.DisplayAlerts = True
        ElseIf bool = False Then
            Sheets(Sheets.Count).Name = "fich-" & i - 9
            With ActiveSheet
                .Cells(3, 9) = Sheets("Tableau").Cells(i, 1).Value
                .Cells(5, 9) = Sheets("Tableau").Cells(i, 2).Value
                .Cells(6, 5) = Sheets("Tableau").Cells(i, 13).Value
                .Cells(42, 9) = Sheets("Tableau").Cells(i, 10).Value
                .Cells(13, 2) = Sheets("Tableau").Cells(i, 14).Value
                .Cells(2, 9) = "num_" & i - 9
                .Cells(4, 8) = Sheets("Tableau").Cells(3, 10).Value
            End With
        End If
    bool = False
Next i
Application.ScreenUpdating = True
End Sub

@+

Dan · 21 Septembre 2006

Re : empecher doublons de feuilles

Re,

Bon Gregouille, j'aurais parié que tu allais venir sur ce sujet là. Mais comme tu n'avais rien dit, je ne t'ai rien proposé dans le fil https://www.excel-downloads.com/threads/macro-pour-creer-des-feuilles.66977/.

Voici une solution qui te supprimera toutes les feuilles avant de générer les autres. Donc chaque fois que tu cliqueras sur ton bouton toutes les feuilles seront effacées et regénérées à nouveau.

Code:

Sub Transfert()
'Macro par DAN pour Gregouille  le 19/09/2006
'Fil : http://www.excel-downloads.com/forum...-feuilles.html
Dim i As Byte, lig As Integer, ligne As Integer
Dim w As Worksheet
With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With
On Error Resume Next
For Each w In Sheets
If w.Name = "tableau" Or w.Name = "aid_form" Or w.Name = "mod_fich" Then
Else: w.Delete
End If
Next w
 lig = Sheets("Tableau").Range("A32").Row
 For i = 10 To lig
 If Sheets("Tableau").Range("A" & i).Value = 0 Then _
 Sheets("mod_fich").Visible = False: End
 With Sheets("mod_fich")
    .Visible = True
    .Copy after:=Worksheets(Worksheets.Count)
 End With
 ActiveSheet.Name = "fich_" & i - 9
 With ActiveSheet
 .Cells(4, 8) = Sheets("Tableau").Cells(3, 10).Value
 .Cells(3, 9) = Sheets("Tableau").Cells(i, 1).Value
 .Cells(5, 9) = Sheets("Tableau").Cells(i, 2).Value
 .Cells(6, 5) = Sheets("Tableau").Cells(i, 13).Value
 .Cells(42, 9) = Sheets("Tableau").Cells(i, 10).Value
 .Cells(13, 2) = Sheets("Tableau").Cells(i, 14).Value
 .Cells(2, 9) = "num_" & i - 9
 End With
Next i
Application.ScreenUpdating = True
End Sub

Regarde si cela te convient.

gregouille · 22 Septembre 2006

Re : empecher doublons de feuilles

donc en faite j'ai cherché un peu pendant que j'étais au boulot

Sub Transfert()
'Macro par DAN pour Gregouille le 19/09/2006
'Fil : Lien supprimé
Dim i As Byte, lig As Integer, ligne As Integer
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
On Error Resume Next
lig = Sheets("Tableau").Range("A32").Row
For i = 10 To lig
If Sheets("Tableau").Range("A" & i).Value = 0 Then _
Sheets("mod_fich").Visible = False: End
With Sheets("mod_fich")
.Visible = True
.Copy after:=Worksheets(Worksheets.Count)
End With
ActiveSheet.Name = "fich_" & i - 9
With ActiveSheet
.Cells(3, 9) = Sheets("Tableau").Cells(i, 1).Value
.Cells(5, 9) = Sheets("Tableau").Cells(i, 2).Value
.Cells(6, 5) = Sheets("Tableau").Cells(i, 13).Value
.Cells(42, 9) = Sheets("Tableau").Cells(i, 10).Value
.Cells(13, 2) = Sheets("Tableau").Cells(i, 14).Value
.Cells(2, 9) = "num_" & i - 9
.Cells(4, 8) = Sheets("Tableau").Cells(3, 10).Value
.Cells(24, 2) = Sheets("aid_form").Cells(i, 10).Value
End With
With Sheets("mod_fich (2)").Delete
End With
Next i
Application.ScreenUpdating = True
End Sub

et voila ce que ca donne au lieu de toute les éffacer il éfface les nouvelles feuilles qui se nomment "mod_fich (2)" au fur et a mesure qu'elles se créer

j'ai just repris "displayalert" qui me posait un pb dans la macro que tu m'as fait

empecher doublons de feuilles

gregouille

XLDnaute Nouveau

nat54

XLDnaute Barbatruc

gregouille

XLDnaute Nouveau

nat54

XLDnaute Barbatruc

gregouille

XLDnaute Nouveau

Pièces jointes

porcinet82

XLDnaute Barbatruc

Dan

XLDnaute Barbatruc

gregouille

XLDnaute Nouveau

Discussions similaires

empecher doublons de feuilles

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Nouveau

Discussions similaires

Privacy & Transparency

Privacy & Transparency