Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Pb sur Macro

Pb sur Macro

11 réponses
Avatar
philou36
Bonjour =E0 tous !

J'ai un soucis avec cette macro. Elle marche parfaitement jusqu'=E0 la
178=E8me copie. Ensuite, il copie mais sur le dernier cr=E9e et il copie
le dernier normalement.

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

Qu'en pensez vous ?

Merci pour vos pr=E9cieux conseils !

Bonne journ=E9e.

Philippe
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
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


Avatar
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 wrote:
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 -


Avatar
philou36
Rebonjour,

Helas rien de changé après rta modif

A +


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

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

Merci encore pour ton aide

Philippe

On 4 mai, 10:18, Daniel.C wrote:



> 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 -


Avatar
Daniel.C
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 wrote:
Bonjour Daniel,

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

Merci encore pour ton aide

Philippe

On 4 mai, 10:18, Daniel.C wrote:



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 -




Avatar
Mishell
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" wrote in message
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
Avatar
Misange
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 !
Avatar
Calou
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" a écrit dans le message de news:
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" wrote in message
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




Avatar
Mishell
"Calou" wrote in message
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" a écrit dans le message de news:
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" wrote in message
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








Avatar
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.Value

End If
Next

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

Application.ScreenUpdating = True
End Sub

"Calou" wrote in message
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" a écrit dans le message de news:
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" wrote in message
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








Avatar
philou36
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" wrote:
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" wrote in message

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" a écrit dans le message de news:
> 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" wrote in message
>>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 -


1 2