Pb sur Macro

Le
philou36
Bonjour tous !

J'ai un soucis avec cette macro. Elle marche parfaitement jusqu' la
178me copie. Ensuite, il copie mais sur le dernier cre et il copie
le dernier normalement.

Sub CreationOnglet()
' Cration des onglets selon la feuille Modele
For Each c In Range([b2], [b65000].End(xlUp))
On Error Resume Next
temp = Sheets(c.Value).Range("b2").Value
If Err > 0 Then
Sheets("Modele").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = c
ActiveSheet.Hyperlinks.Add Anchor:=c, Address:="", _
SubAddress:="'" & c & "'" & "!b2", TextToDisplay:=c.Value
End If
Next
Feuil1.Visible = True
Feuil1.Select
End Sub

Qu'en pensez vous ?

Merci pour vos prcieux conseils !

Bonne journe.

Philippe
Vos réponses Page 1 / 2
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Daniel.C
Le #19259941
Bonjour.
Un peu au hasard, essaie de mettre :
If Err.Number > 0 Then
Sheets("Modele").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = c
ActiveSheet.Hyperlinks.Add Anchor:=c, Address:="", _
SubAddress:="'" & c & "'" & "!b2", TextToDisplay:=c.Value
Err.Clear
End If
Cordialement.
Daniel

Bonjour à tous !

J'ai un soucis avec cette macro. Elle marche parfaitement jusqu'à la
178ème copie. Ensuite, il copie mais sur le dernier crée et il copie
le dernier normalement.

Sub CreationOnglet()
' Création des onglets selon la feuille Modele
For Each c In Range([b2], [b65000].End(xlUp))
On Error Resume Next
temp = Sheets(c.Value).Range("b2").Value
If Err > 0 Then
Sheets("Modele").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = c
ActiveSheet.Hyperlinks.Add Anchor:=c, Address:="", _
SubAddress:="'" & c & "'" & "!b2", TextToDisplay:=c.Value
End If
Next
Feuil1.Visible = True
Feuil1.Select
End Sub

Qu'en pensez vous ?

Merci pour vos précieux conseils !

Bonne journée.

Philippe


philou36
Le #19260661
Bonjour Daniel,

Je fais le test et je te dis ça !!

Merci encore pour ton aide

Philippe



On 4 mai, 10:18, Daniel.C
Bonjour.
Un peu au hasard, essaie de mettre :
   If Err.Number > 0 Then
     Sheets("Modele").Copy After:=Sheets(Sheets.Count)
     ActiveSheet.Name = c
     ActiveSheet.Hyperlinks.Add Anchor:=c, Address:="", _
      SubAddress:="'" & c & "'" & "!b2", TextToDisplay:=c.Value
      Err.Clear
    End If
Cordialement.
Daniel



> Bonjour à tous !

> J'ai un soucis avec cette macro. Elle marche parfaitement jusqu'à la
> 178ème copie. Ensuite, il copie mais sur le dernier crée et il copi e
> le dernier normalement.

> Sub CreationOnglet()
> ' Création des onglets selon la feuille Modele
>  For Each c In Range([b2], [b65000].End(xlUp))
>    On Error Resume Next
>    temp = Sheets(c.Value).Range("b2").Value
>    If Err > 0 Then
>      Sheets("Modele").Copy After:=Sheets(Sheets.Count)
>      ActiveSheet.Name = c
>      ActiveSheet.Hyperlinks.Add Anchor:=c, Address:="", _
>       SubAddress:="'" & c & "'" & "!b2", TextToDisplay:=c.Val ue
>     End If
>   Next
>   Feuil1.Visible = True
>   Feuil1.Select
> End Sub

> Qu'en pensez vous ?

> Merci pour vos précieux conseils !

> Bonne journée.

> Philippe- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -


philou36
Le #19264731
Rebonjour,

Helas rien de changé après rta modif

A +


On 4 mai, 10:32, philou36
Bonjour Daniel,

Je fais le test et je te dis ça !!

Merci encore pour ton aide

Philippe

On 4 mai, 10:18, Daniel.C


> Bonjour.
> Un peu au hasard, essaie de mettre :
>    If Err.Number > 0 Then
>      Sheets("Modele").Copy After:=Sheets(Sheets.Count)
>      ActiveSheet.Name = c
>      ActiveSheet.Hyperlinks.Add Anchor:=c, Address:="", _
>       SubAddress:="'" & c & "'" & "!b2", TextToDisplay:=c.Val ue
>       Err.Clear
>     End If
> Cordialement.
> Daniel

> > Bonjour à tous !

> > J'ai un soucis avec cette macro. Elle marche parfaitement jusqu'à l a
> > 178ème copie. Ensuite, il copie mais sur le dernier crée et il co pie
> > le dernier normalement.

> > Sub CreationOnglet()
> > ' Création des onglets selon la feuille Modele
> >  For Each c In Range([b2], [b65000].End(xlUp))
> >    On Error Resume Next
> >    temp = Sheets(c.Value).Range("b2").Value
> >    If Err > 0 Then
> >      Sheets("Modele").Copy After:=Sheets(Sheets.Count)
> >      ActiveSheet.Name = c
> >      ActiveSheet.Hyperlinks.Add Anchor:=c, Address:="", _
> >       SubAddress:="'" & c & "'" & "!b2", TextToDisplay:=c.V alue
> >     End If
> >   Next
> >   Feuil1.Visible = True
> >   Feuil1.Select
> > End Sub

> > Qu'en pensez vous ?

> > Merci pour vos précieux conseils !

> > Bonne journée.

> > Philippe- Masquer le texte des messages précédents -

> - Afficher le texte des messages précédents -- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -


Daniel.C
Le #19264721
Est-ce que tu peux expliciter "Ensuite, il copie mais sur le dernier
crée et il copie le dernier normalement." ?
Combien as-tu de feuilles au total ?
Daniel


Rebonjour,

Helas rien de changé après rta modif

A +


On 4 mai, 10:32, philou36
Bonjour Daniel,

Je fais le test et je te dis ça !!

Merci encore pour ton aide

Philippe

On 4 mai, 10:18, Daniel.C


Bonjour.
Un peu au hasard, essaie de mettre :
   If Err.Number > 0 Then
     Sheets("Modele").Copy After:=Sheets(Sheets.Count)
     ActiveSheet.Name = c
     ActiveSheet.Hyperlinks.Add Anchor:=c, Address:="", _
      SubAddress:="'" & c & "'" & "!b2", TextToDisplay:=c.Value
      Err.Clear
    End If
Cordialement.
Daniel



Bonjour à tous !





J'ai un soucis avec cette macro. Elle marche parfaitement jusqu'à la
178ème copie. Ensuite, il copie mais sur le dernier crée et il copie
le dernier normalement.





Sub CreationOnglet()
' Création des onglets selon la feuille Modele
 For Each c In Range([b2], [b65000].End(xlUp))
   On Error Resume Next
   temp = Sheets(c.Value).Range("b2").Value
   If Err > 0 Then
     Sheets("Modele").Copy After:=Sheets(Sheets.Count)
     ActiveSheet.Name = c
     ActiveSheet.Hyperlinks.Add Anchor:=c, Address:="", _
      SubAddress:="'" & c & "'" & "!b2", TextToDisplay:=c.Value
    End If
  Next
  Feuil1.Visible = True
  Feuil1.Select
End Sub





Qu'en pensez vous ?





Merci pour vos précieux conseils !
Bonne journée.





Philippe- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -- Masquer le texte des
messages précédents -



- Afficher le texte des messages précédents -




Mishell
Le #19264581
Est-ce que ca fonctionne avec ce code?
Sub CreationOnglet()
For Each c In Range([b2], [b65000].End(xlUp))
On Error Resume Next
temp = Sheets(c.Value).Range("b2").Value
If Err > 0 Then
Err.Clear
On Error GoTo 0
' Sheets("Modele").Copy After:=Sheets(Sheets.Count)
Dim shtoto As Worksheet

Set shtoto = Sheets.Add(After:=Sheets(Sheets.Count))

shtoto.Name = c

Sheets("Modele").Select
Sheets("Modele").Cells.Select
Application.CutCopyMode = False
Selection.Copy

shtoto.Select
ActiveSheet.Paste
Application.CutCopyMode = False

Sheets("Accueil").Select
c.Select

c.Hyperlinks.Add Anchor:=c, Address:="", _
SubAddress:="'" & c & "'" & "!b2" ', TextToDisplay:=c.Value

ActiveCell.Select

End If
Next
Feuil1.Visible = True
Feuil1.Select
End Sub

Mishell

"philou36" news:
Bonjour à tous !

J'ai un soucis avec cette macro. Elle marche parfaitement jusqu'à la
178ème copie. Ensuite, il copie mais sur le dernier crée et il copie
le dernier normalement.

Sub CreationOnglet()
' Création des onglets selon la feuille Modele
For Each c In Range([b2], [b65000].End(xlUp))
On Error Resume Next
temp = Sheets(c.Value).Range("b2").Value
If Err > 0 Then
Sheets("Modele").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = c
ActiveSheet.Hyperlinks.Add Anchor:=c, Address:="", _
SubAddress:="'" & c & "'" & "!b2", TextToDisplay:=c.Value
End If
Next
Feuil1.Visible = True
Feuil1.Select
End Sub

Qu'en pensez vous ?

Merci pour vos précieux conseils !

Bonne journée.

Philippe
Misange
Le #19264471
philou36 a écrit :
Rebonjour,

Helas rien de changé après rta modif


Bonjour

Esssaie de voir si le problème vient des données ou de leur position en
changeant le contenu de la ligne qui produit le pb.

--
Misange migrateuse
http://www.excelabo.net : Participez à un travail collaboratif sur excel !
Calou
Le #19266261
Bonjour,
Ta procédure va à son terme mais le soucis c'est qu'il copie la feuille
modèle mais sans certaine formule. Sinon ta procédure va extremement vite.
Comment as tu fait ??

Cette procédure tourne mais à la vitesse d'une escargot (environ 250
matricule et noms à ecrire dans un tableau).

Qu'en penses tu ?

Bonne journée

Philippe
"Mishell" e$
Est-ce que ca fonctionne avec ce code?
Sub CreationOnglet()
For Each c In Range([b2], [b65000].End(xlUp))
On Error Resume Next
temp = Sheets(c.Value).Range("b2").Value
If Err > 0 Then
Err.Clear
On Error GoTo 0
' Sheets("Modele").Copy After:=Sheets(Sheets.Count)
Dim shtoto As Worksheet

Set shtoto = Sheets.Add(After:=Sheets(Sheets.Count))

shtoto.Name = c

Sheets("Modele").Select
Sheets("Modele").Cells.Select
Application.CutCopyMode = False
Selection.Copy

shtoto.Select
ActiveSheet.Paste
Application.CutCopyMode = False

Sheets("Accueil").Select
c.Select

c.Hyperlinks.Add Anchor:=c, Address:="", _
SubAddress:="'" & c & "'" & "!b2" ', TextToDisplay:=c.Value

ActiveCell.Select

End If
Next
Feuil1.Visible = True
Feuil1.Select
End Sub

Mishell

"philou36" news:
Bonjour à tous !

J'ai un soucis avec cette macro. Elle marche parfaitement jusqu'à la
178ème copie. Ensuite, il copie mais sur le dernier crée et il copie
le dernier normalement.

Sub CreationOnglet()
' Création des onglets selon la feuille Modele
For Each c In Range([b2], [b65000].End(xlUp))
On Error Resume Next
temp = Sheets(c.Value).Range("b2").Value
If Err > 0 Then
Sheets("Modele").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = c
ActiveSheet.Hyperlinks.Add Anchor:=c, Address:="", _
SubAddress:="'" & c & "'" & "!b2", TextToDisplay:=c.Value
End If
Next
Feuil1.Visible = True
Feuil1.Select
End Sub

Qu'en pensez vous ?

Merci pour vos précieux conseils !

Bonne journée.

Philippe




Mishell
Le #19266251
"Calou" news:Oc%
Bonjour,
Ta procédure va à son terme mais le soucis c'est qu'il copie la feuille
modèle mais sans certaine formule.



Voilà qui est étonnant.
Quelle formule n'est pas copiée?

Sinon ta procédure va extremement vite. Comment as tu fait ??



J'ai simplement remplacé
Sheets("Modele").Copy After:=Sheets(Sheets.Count)
par
Set shtoto = Sheets.Add(After:=Sheets(Sheets.Count))
C'est peut-être ce qui augmente la rapidité d'exécution. Je ne sais pas. Il
faudrait demander aux gurus.

Elle pourrait être encore plus rapide en mettant au début de la procédure,
la commande
Application.ScreenUpdating = False



Cette procédure tourne mais à la vitesse d'une escargot (environ 250
matricule et noms à ecrire dans un tableau).

Qu'en penses tu ?

Bonne journée

Philippe
"Mishell" e$
Est-ce que ca fonctionne avec ce code?
Sub CreationOnglet()
For Each c In Range([b2], [b65000].End(xlUp))
On Error Resume Next
temp = Sheets(c.Value).Range("b2").Value
If Err > 0 Then
Err.Clear
On Error GoTo 0
' Sheets("Modele").Copy After:=Sheets(Sheets.Count)
Dim shtoto As Worksheet

Set shtoto = Sheets.Add(After:=Sheets(Sheets.Count))

shtoto.Name = c

Sheets("Modele").Select
Sheets("Modele").Cells.Select
Application.CutCopyMode = False
Selection.Copy

shtoto.Select
ActiveSheet.Paste
Application.CutCopyMode = False

Sheets("Accueil").Select
c.Select

c.Hyperlinks.Add Anchor:=c, Address:="", _
SubAddress:="'" & c & "'" & "!b2" ', TextToDisplay:=c.Value

ActiveCell.Select

End If
Next
Feuil1.Visible = True
Feuil1.Select
End Sub

Mishell

"philou36" news:
Bonjour à tous !

J'ai un soucis avec cette macro. Elle marche parfaitement jusqu'à la
178ème copie. Ensuite, il copie mais sur le dernier crée et il copie
le dernier normalement.

Sub CreationOnglet()
' Création des onglets selon la feuille Modele
For Each c In Range([b2], [b65000].End(xlUp))
On Error Resume Next
temp = Sheets(c.Value).Range("b2").Value
If Err > 0 Then
Sheets("Modele").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = c
ActiveSheet.Hyperlinks.Add Anchor:=c, Address:="", _
SubAddress:="'" & c & "'" & "!b2", TextToDisplay:=c.Value
End If
Next
Feuil1.Visible = True
Feuil1.Select
End Sub

Qu'en pensez vous ?

Merci pour vos précieux conseils !

Bonne journée.

Philippe








Mishell
Le #19266241
Voici un code plus facile à lire:

Sub CreationOnglet()

Application.ScreenUpdating = False
'Gèle l'affichage à l'écran: cela accélère le déroulement de la macro.

Set origSheet = Sheets("Modele")

For Each c In Sheets("Accueil").Range([b2], [b65000].End(xlUp))
On Error Resume Next
temp = Sheets(c.Value).Range("b2").Value
If Err > 0 Then
Err.Clear
On Error GoTo 0

Set NewSheet = Sheets.Add(After:=Sheets(Sheets.Count))

origSheet.Activate
origSheet.Cells.Copy
NewSheet.Activate
ActiveSheet.Paste

NewSheet.Name = c

Application.CutCopyMode = False

Sheets("Accueil").Select

c.Hyperlinks.Add Anchor:=c, Address:="", _
SubAddress:="'" & c & "'" & "!b2" ', TextToDisplay:=c.Value

End If
Next

Sheets("Accueil").Visible = True
Sheets("Accueil").Select

Application.ScreenUpdating = True
End Sub

"Calou" news:Oc%
Bonjour,
Ta procédure va à son terme mais le soucis c'est qu'il copie la feuille
modèle mais sans certaine formule. Sinon ta procédure va extremement vite.
Comment as tu fait ??

Cette procédure tourne mais à la vitesse d'une escargot (environ 250
matricule et noms à ecrire dans un tableau).

Qu'en penses tu ?

Bonne journée

Philippe
"Mishell" e$
Est-ce que ca fonctionne avec ce code?
Sub CreationOnglet()
For Each c In Range([b2], [b65000].End(xlUp))
On Error Resume Next
temp = Sheets(c.Value).Range("b2").Value
If Err > 0 Then
Err.Clear
On Error GoTo 0
' Sheets("Modele").Copy After:=Sheets(Sheets.Count)
Dim shtoto As Worksheet

Set shtoto = Sheets.Add(After:=Sheets(Sheets.Count))

shtoto.Name = c

Sheets("Modele").Select
Sheets("Modele").Cells.Select
Application.CutCopyMode = False
Selection.Copy

shtoto.Select
ActiveSheet.Paste
Application.CutCopyMode = False

Sheets("Accueil").Select
c.Select

c.Hyperlinks.Add Anchor:=c, Address:="", _
SubAddress:="'" & c & "'" & "!b2" ', TextToDisplay:=c.Value

ActiveCell.Select

End If
Next
Feuil1.Visible = True
Feuil1.Select
End Sub

Mishell

"philou36" news:
Bonjour à tous !

J'ai un soucis avec cette macro. Elle marche parfaitement jusqu'à la
178ème copie. Ensuite, il copie mais sur le dernier crée et il copie
le dernier normalement.

Sub CreationOnglet()
' Création des onglets selon la feuille Modele
For Each c In Range([b2], [b65000].End(xlUp))
On Error Resume Next
temp = Sheets(c.Value).Range("b2").Value
If Err > 0 Then
Sheets("Modele").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = c
ActiveSheet.Hyperlinks.Add Anchor:=c, Address:="", _
SubAddress:="'" & c & "'" & "!b2", TextToDisplay:=c.Value
End If
Next
Feuil1.Visible = True
Feuil1.Select
End Sub

Qu'en pensez vous ?

Merci pour vos précieux conseils !

Bonne journée.

Philippe








philou36
Le #19266771
Bonjour,
et avant toute chose merci pour avoir pris de ton temps pour trouver
une solution à mon problème.
Pour une raison qui m'echappe, la procédure ne me copie pas toutes les
formules.
Laisse tomber, je vais limiter mes traitements à 120 personnes environ
et tout devrait être réglé.

On 5 mai, 07:01, "Mishell"
Voici un code plus facile à lire:

Sub CreationOnglet()

 Application.ScreenUpdating = False
'Gèle l'affichage à l'écran: cela accélère le déroulement de la macro.

Set origSheet = Sheets("Modele")

 For Each c In Sheets("Accueil").Range([b2], [b65000].End(xlUp))
   On Error Resume Next
   temp = Sheets(c.Value).Range("b2").Value
   If Err > 0 Then
    Err.Clear
    On Error GoTo 0

   Set NewSheet = Sheets.Add(After:=Sheets(Sheets.Count))

   origSheet.Activate
   origSheet.Cells.Copy
   NewSheet.Activate
   ActiveSheet.Paste

 NewSheet.Name = c

 Application.CutCopyMode = False

 Sheets("Accueil").Select

     c.Hyperlinks.Add Anchor:=c, Address:="", _
      SubAddress:="'" & c & "'" & "!b2" ', TextToDisplay:=c.Val ue

     End If
  Next

  Sheets("Accueil").Visible = True
  Sheets("Accueil").Select

  Application.ScreenUpdating = True
End Sub

"Calou"
news:Oc%



> Bonjour,
> Ta procédure va à son terme mais le soucis c'est qu'il copie la feu ille
> modèle mais sans certaine formule. Sinon ta procédure va extrememen t vite.
> Comment as tu fait ??

> Cette procédure tourne mais à la vitesse d'une escargot (environ 25 0
> matricule et noms à ecrire dans un tableau).

> Qu'en penses tu ?

> Bonne journée

> Philippe
> "Mishell" > e$
>> Est-ce que ca fonctionne avec ce code?
>> Sub CreationOnglet()
>> For Each c In Range([b2], [b65000].End(xlUp))
>>   On Error Resume Next
>>   temp = Sheets(c.Value).Range("b2").Value
>>   If Err > 0 Then
>>    Err.Clear
>>    On Error GoTo 0
>> '     Sheets("Modele").Copy After:=Sheets(Sheets.Count)
>>     Dim shtoto As Worksheet

>>     Set shtoto = Sheets.Add(After:=Sheets(Sheets.Count))

>>     shtoto.Name = c

>> Sheets("Modele").Select
>> Sheets("Modele").Cells.Select
>> Application.CutCopyMode = False
>> Selection.Copy

>> shtoto.Select
>> ActiveSheet.Paste
>> Application.CutCopyMode = False

>> Sheets("Accueil").Select
>>    c.Select

>>     c.Hyperlinks.Add Anchor:=c, Address:="", _
>>      SubAddress:="'" & c & "'" & "!b2" ', TextToDisplay:=c.V alue

>>    ActiveCell.Select

>>     End If
>>  Next
>>  Feuil1.Visible = True
>>  Feuil1.Select
>> End Sub

>> Mishell

>> "philou36" >>news: ..
>> Bonjour à tous !

>> J'ai un soucis avec cette macro. Elle marche parfaitement jusqu'à la
>> 178ème copie. Ensuite, il copie mais sur le dernier crée et il cop ie
>> le dernier normalement.

>> Sub CreationOnglet()
>> ' Création des onglets selon la feuille Modele
>> For Each c In Range([b2], [b65000].End(xlUp))
>>   On Error Resume Next
>>   temp = Sheets(c.Value).Range("b2").Value
>>   If Err > 0 Then
>>     Sheets("Modele").Copy After:=Sheets(Sheets.Count)
>>     ActiveSheet.Name = c
>>     ActiveSheet.Hyperlinks.Add Anchor:=c, Address:="", _
>>      SubAddress:="'" & c & "'" & "!b2", TextToDisplay:=c.Val ue
>>    End If
>>  Next
>>  Feuil1.Visible = True
>>  Feuil1.Select
>> End Sub

>> Qu'en pensez vous ?

>> Merci pour vos précieux conseils !

>> Bonne journée.

>> Philippe- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -


Publicité
Poster une réponse
Anonyme