Sub très lente - comment optimiser

Bonjour à tous
Personne n'a l'air intéressé :-[
J'ai passé du papier de verre partout sur cette sub, mais malgré une nette
amélioration, elle a toujours l'air de fonctionner à la voile, et je ne vois pas
comment lui mettre le turbo..
A suivre ...
@+
J@@

J@@ wrote:

Dans un fichier d'une soixantaine de feuilles je récupère quelques
données sur chaque feuille que je colle dans une feuille appelée "Etat".
Avant optimisation ma sub tournait en 45 secondes, après en 35, mais
c'est bien long :-[
Quelqu'un aurait une idée??

'******
Sub RecupDonnees()
Dim Feuille As Worksheet
Dim ActivationEvents As Long
Dim ModeRecalcul As Long

Sheets("Etat").Select
ActiveSheet.Unprotect
Range("B5:N58").ClearContents

Application.ScreenUpdating = False
ModeRecalcul = Application.Calculation
Application.Calculation = xlCalculationManual
ActivationEvents = Application.EnableEvents
Application.EnableEvents = False

For Each Feuille In ActiveWorkbook.Worksheets
If Feuille.Name <> "ALIRE" _
And Feuille.Name <> "Etat" Then
With Feuille
Worksheets("Etat").Range("B100").End(xlUp)(2).Value = .Name
Worksheets("Etat").Range("C100").End(xlUp)(2).Value = .[B27]
Worksheets("Etat").Range("D100").End(xlUp)(2).Value = .[B29]
Worksheets("Etat").Range("E100").End(xlUp)(2).Value = .[B28]
Worksheets("Etat").Range("F100").End(xlUp)(2).Value = .[B31]
Worksheets("Etat").Range("G100").End(xlUp)(2).Value = .[C27]
Worksheets("Etat").Range("H100").End(xlUp)(2).Value = .[C29]
Worksheets("Etat").Range("I100").End(xlUp)(2).Value = .[C28]
Worksheets("Etat").Range("J100").End(xlUp)(2).Value = .[C33]
Worksheets("Etat").Range("K100").End(xlUp)(2).Value = .[D27]
Worksheets("Etat").Range("L100").End(xlUp)(2).Value = .[D29]
Worksheets("Etat").Range("M100").End(xlUp)(2).Value = .[D28]
Worksheets("Etat").Range("N100").End(xlUp)(2).Value = .[D33]
End With
End If
Next Feuille

Application.EnableEvents = ActivationEvents
Application.Calculation = ModeRecalcul

ActiveSheet.Protect
End Sub
'******

Je suppose que ma réponse n'en était pas une ?


"J@@" <jipivert@-ifrance.com> a écrit dans le message de news:
u01SHrsNHHA.2140@TK2MSFTNGP03.phx.gbl...
Bonjour à tous
Personne n'a l'air intéressé :-[
J'ai passé du papier de verre partout sur cette sub, mais malgré une nette
amélioration, elle a toujours l'air de fonctionner à la voile, et je ne vois pas
comment lui mettre le turbo..
A suivre ...
@+
J@@

J@@ wrote:

Dans un fichier d'une soixantaine de feuilles je récupère quelques
données sur chaque feuille que je colle dans une feuille appelée "Etat".
Avant optimisation ma sub tournait en 45 secondes, après en 35, mais
c'est bien long :-[
Quelqu'un aurait une idée??

'******
Sub RecupDonnees()
Dim Feuille As Worksheet
Dim ActivationEvents As Long
Dim ModeRecalcul As Long

Sheets("Etat").Select
ActiveSheet.Unprotect
Range("B5:N58").ClearContents

Application.ScreenUpdating = False
ModeRecalcul = Application.Calculation
Application.Calculation = xlCalculationManual
ActivationEvents = Application.EnableEvents
Application.EnableEvents = False

For Each Feuille In ActiveWorkbook.Worksheets
If Feuille.Name <> "ALIRE" _
And Feuille.Name <> "Etat" Then
With Feuille
Worksheets("Etat").Range("B100").End(xlUp)(2).Value = .Name
Worksheets("Etat").Range("C100").End(xlUp)(2).Value = .[B27]
Worksheets("Etat").Range("D100").End(xlUp)(2).Value = .[B29]
Worksheets("Etat").Range("E100").End(xlUp)(2).Value = .[B28]
Worksheets("Etat").Range("F100").End(xlUp)(2).Value = .[B31]
Worksheets("Etat").Range("G100").End(xlUp)(2).Value = .[C27]
Worksheets("Etat").Range("H100").End(xlUp)(2).Value = .[C29]
Worksheets("Etat").Range("I100").End(xlUp)(2).Value = .[C28]
Worksheets("Etat").Range("J100").End(xlUp)(2).Value = .[C33]
Worksheets("Etat").Range("K100").End(xlUp)(2).Value = .[D27]
Worksheets("Etat").Range("L100").End(xlUp)(2).Value = .[D29]
Worksheets("Etat").Range("M100").End(xlUp)(2).Value = .[D28]
Worksheets("Etat").Range("N100").End(xlUp)(2).Value = .[D33]
End With
End If
Next Feuille

Application.EnableEvents = ActivationEvents
Application.Calculation = ModeRecalcul

ActiveSheet.Protect
End Sub
'******

Bonjour MichDenis
Je ne vois pas ta réponse; sincèrement désolé, je ne sais pas où elle est. Le
serveur de MS nous aurait fait un tour?
Je t'aurais fait retour sinon.
Peux-tu, stp, reposter?
Merci
Amicalement
J@@

MichDenis wrote:

Je suppose que ma réponse n'en était pas une ?


"J@@" <jipivert@-ifrance.com> a écrit dans le message de news:
u01SHrsNHHA.2140@TK2MSFTNGP03.phx.gbl...
Bonjour à tous
Personne n'a l'air intéressé :-[
J'ai passé du papier de verre partout sur cette sub, mais malgré une nette
amélioration, elle a toujours l'air de fonctionner à la voile, et je ne vois pas
comment lui mettre le turbo..
A suivre ...
@+
J@@

J@@ wrote:

Dans un fichier d'une soixantaine de feuilles je récupère quelques
données sur chaque feuille que je colle dans une feuille appelée "Etat".
Avant optimisation ma sub tournait en 45 secondes, après en 35, mais
c'est bien long :-[
Quelqu'un aurait une idée??

'******
Sub RecupDonnees()
Dim Feuille As Worksheet
Dim ActivationEvents As Long
Dim ModeRecalcul As Long

Sheets("Etat").Select
ActiveSheet.Unprotect
Range("B5:N58").ClearContents

Application.ScreenUpdating = False
ModeRecalcul = Application.Calculation
Application.Calculation = xlCalculationManual
ActivationEvents = Application.EnableEvents
Application.EnableEvents = False

For Each Feuille In ActiveWorkbook.Worksheets
If Feuille.Name <> "ALIRE" _
And Feuille.Name <> "Etat" Then
With Feuille
Worksheets("Etat").Range("B100").End(xlUp)(2).Value = .Name
Worksheets("Etat").Range("C100").End(xlUp)(2).Value = .[B27]
Worksheets("Etat").Range("D100").End(xlUp)(2).Value = .[B29]
Worksheets("Etat").Range("E100").End(xlUp)(2).Value = .[B28]
Worksheets("Etat").Range("F100").End(xlUp)(2).Value = .[B31]
Worksheets("Etat").Range("G100").End(xlUp)(2).Value = .[C27]
Worksheets("Etat").Range("H100").End(xlUp)(2).Value = .[C29]
Worksheets("Etat").Range("I100").End(xlUp)(2).Value = .[C28]
Worksheets("Etat").Range("J100").End(xlUp)(2).Value = .[C33]
Worksheets("Etat").Range("K100").End(xlUp)(2).Value = .[D27]
Worksheets("Etat").Range("L100").End(xlUp)(2).Value = .[D29]
Worksheets("Etat").Range("M100").End(xlUp)(2).Value = .[D28]
Worksheets("Etat").Range("N100").End(xlUp)(2).Value = .[D33]
End With
End If
Next Feuille

Application.EnableEvents = ActivationEvents
Application.Calculation = ModeRecalcul

ActiveSheet.Protect
End Sub
'******

| Peux-tu, stp, reposter?

3 suggestions :
A )
Cette syntaxe est supérieur en rapidité à ceci :
.[B27] -> tu devrais utiliser ce type de syntaxe .Range("B27")

B ) Si tes enregistrements ont lieu sur la même ligne pour tous les
éléments d'une même boucle, pourquoi ne pas utiliser une variable
au lieu de réévaluer la cellule suivante disponible sur la colonne

Dim Ligne as Long
Ligne = Worksheets("Etat").Range("B100").End(xlUp)(2).Value
Et pour tes écritures dans la boucle pour chacun des items :
Worksheets("Etat").Range("B" & ligne) = .Name

C ) Remplace Worksheets("Etat"). par une variable
dim Sh as Worksheet
Set Sh = Worksheets("Etat")
Et dans ton code, tu remplaces ceci
Worksheets("Etat").Range("B100").End(xlUp)(2).Value = .Name
Par
Sh.Range("B" & ligne) = .Name

Re-bonjour
Grand merci à toi
Je m'y colle
Je reviendrai avec les nouvelles :-)
amicalement
@+
J@@ (même sur Google mes messages, et ta réponse, n'apparaissaient pas :-[

MichDenis wrote:

| Peux-tu, stp, reposter?

3 suggestions :
A )
Cette syntaxe est supérieur en rapidité à ceci :
..[B27] -> tu devrais utiliser ce type de syntaxe .Range("B27")

B ) Si tes enregistrements ont lieu sur la même ligne pour tous les
éléments d'une même boucle, pourquoi ne pas utiliser une variable
au lieu de réévaluer la cellule suivante disponible sur la colonne

Dim Ligne as Long
Ligne = Worksheets("Etat").Range("B100").End(xlUp)(2).Value
Et pour tes écritures dans la boucle pour chacun des items :
Worksheets("Etat").Range("B" & ligne) = .Name

C ) Remplace Worksheets("Etat"). par une variable
dim Sh as Worksheet
Set Sh = Worksheets("Etat")
Et dans ton code, tu remplaces ceci
Worksheets("Etat").Range("B100").End(xlUp)(2).Value = .Name
Par
Sh.Range("B" & ligne) = .Name

Re bonjour

On est passé d'environ 40 à 13 secondes :-)
Mais bizarrement le "ScreenUpdating = False" n'est pas actif ??
Sinon, peux-tu jeter un coup d'oeil sur le code, me dire si j'ai mis tous les
morceaux du puzzle dans le bon sens :-)
Encore merci
@+
J@@

'*******
Sub RecupDonnees()
Dim Feuille As Worksheet
Dim Sh As Worksheet
Dim Ligne As Long
Set Sh = Worksheets("Etat")
Sh.Select
ActiveSheet.Unprotect
Range("B5:N58").ClearContents

Application.ScreenUpdating = False
ModeRecalcul = Application.Calculation
Application.Calculation = xlCalculationManual
ActivationEvents = Application.EnableEvents
Application.EnableEvents = False

Set Ligne = Sh.Range("B100").End(xlUp)(2).Value

For Each Feuille In ActiveWorkbook.Worksheets
If Feuille.Name <> "ALIRE" _
And Feuille.Name <> "Etat" Then
With Feuille
Sh.Range("B" & Ligne) = .Name
Sh.Range("C" & Ligne) = .Range("B27")
Sh.Range("D" & Ligne) = .Range("B29")
Sh.Range("E" & Ligne) = .Range("B28")
Sh.Range("F" & Ligne) = .Range("B31")
Sh.Range("G" & Ligne) = .Range("C27")
Sh.Range("H" & Ligne) = .Range("C29")
Sh.Range("I" & Ligne) = .Range("C28")
Sh.Range("J" & Ligne) = .Range("C33")
Sh.Range("K" & Ligne) = .Range("D27")
Sh.Range("L" & Ligne) = .Range("D29")
Sh.Range("M" & Ligne) = .Range("D28")
Sh.Range("N" & Ligne) = .Range("D33")
End With
End If
Next Feuille

Application.EnableEvents = ActivationEvents
Application.Calculation = ModeRecalcul
ActiveSheet.Protect
End Sub
'*******

MichDenis wrote:

3 suggestions :
A ) Cette syntaxe est supérieur en rapidité à ceci :
..[B27] -> tu devrais utiliser ce type de syntaxe .Range("B27")

B ) Si tes enregistrements ont lieu sur la même ligne pour tous les
éléments d'une même boucle, pourquoi ne pas utiliser une variable
au lieu de réévaluer la cellule suivante disponible sur la colonne

Dim Ligne as Long
Ligne = Worksheets("Etat").Range("B100").End(xlUp)(2).Value
Et pour tes écritures dans la boucle pour chacun des items :
Worksheets("Etat").Range("B" & ligne) = .Name

C ) Remplace Worksheets("Etat"). par une variable
dim Sh as Worksheet
Set Sh = Worksheets("Etat")
Et dans ton code, tu remplaces ceci
Worksheets("Etat").Range("B100").End(xlUp)(2).Value = .Name
Par
Sh.Range("B" & ligne) = .Name

ReReBonjour MichDenis
Toutes mes excuses, je me suis planté dans mes tests : j'ai 2 fois la même proc:
une dans un module std, l'autre dans le module de feuille activé par un bouton:
c'est cette proc qui est fonctionnelle.
Et mes tests je les ai fait en modifiant le module std (non utilisé), mais en
cliquant sur le bouton de feuille, et en comparant dans ma tête le résultat hier
au boulot et ce matin à la maison, mais mon ordi perso est bien plus véloce :-(

En pratique, voici le code, et j'ai une erreur 1004 sur la ligne
Sh.Range("B" & Ligne) = .Name

Je suis confus
J@@

'****
Sub RecupDonnees()
Dim Feuille As Worksheet
Dim Sh As Worksheet
Dim Ligne As Long
Set Sh = Worksheets("Etat")
Ligne = Sh.Range("B100").End(xlUp)(2).Value
Sh.Select
ActiveSheet.Unprotect
Range("B5:N58").ClearContents

Application.ScreenUpdating = False
ModeRecalcul = Application.Calculation
Application.Calculation = xlCalculationManual
ActivationEvents = Application.EnableEvents
Application.EnableEvents = False

For Each Feuille In ActiveWorkbook.Worksheets
If Feuille.Name <> "ALIRE" _
And Feuille.Name <> "Etat" Then
With Feuille
Sh.Range("B" & Ligne) = .Name
Sh.Range("C" & Ligne) = .Range("B27")
Sh.Range("D" & Ligne) = .Range("B29")
Sh.Range("E" & Ligne) = .Range("B28")
Sh.Range("F" & Ligne) = .Range("B31")
Sh.Range("G" & Ligne) = .Range("C27")
Sh.Range("H" & Ligne) = .Range("C29")
Sh.Range("I" & Ligne) = .Range("C28")
Sh.Range("J" & Ligne) = .Range("C33")
Sh.Range("K" & Ligne) = .Range("D27")
Sh.Range("L" & Ligne) = .Range("D29")
Sh.Range("M" & Ligne) = .Range("D28")
Sh.Range("N" & Ligne) = .Range("D33")
End With
End If
Next Feuille

Application.EnableEvents = ActivationEvents
Application.Calculation = ModeRecalcul

ActiveSheet.Protect

End Sub
'***

MichDenis wrote:

| Peux-tu, stp, reposter?

3 suggestions :
A )
Cette syntaxe est supérieur en rapidité à ceci :
..[B27] -> tu devrais utiliser ce type de syntaxe .Range("B27")

B ) Si tes enregistrements ont lieu sur la même ligne pour tous les
éléments d'une même boucle, pourquoi ne pas utiliser une variable
au lieu de réévaluer la cellule suivante disponible sur la colonne

Dim Ligne as Long
Ligne = Worksheets("Etat").Range("B100").End(xlUp)(2).Value
Et pour tes écritures dans la boucle pour chacun des items :
Worksheets("Etat").Range("B" & ligne) = .Name

C ) Remplace Worksheets("Etat"). par une variable
dim Sh as Worksheet
Set Sh = Worksheets("Etat")
Et dans ton code, tu remplaces ceci
Worksheets("Etat").Range("B100").End(xlUp)(2).Value = .Name
Par
Sh.Range("B" & ligne) = .Name

Tu remplaces cette ligne de code :

Ligne = Sh.Range("B100").End(xlUp)(2).Value

Par
Ligne = Sh.Range("B100").End(xlUp)(2).Row

ça bloque sur cette ligne :
Sh.Range("B" & Ligne) = .Name

Par la variable Ligne = 0 et que dans excel
il n'y a aucune ligne portant le numéro 0



"J@@" <jipivert@-ifrance.com> a écrit dans le message de news:
%23DPggd0NHHA.5016@TK2MSFTNGP04.phx.gbl...
ReReBonjour MichDenis
Toutes mes excuses, je me suis planté dans mes tests : j'ai 2 fois la même proc:
une dans un module std, l'autre dans le module de feuille activé par un bouton:
c'est cette proc qui est fonctionnelle.
Et mes tests je les ai fait en modifiant le module std (non utilisé), mais en
cliquant sur le bouton de feuille, et en comparant dans ma tête le résultat hier
au boulot et ce matin à la maison, mais mon ordi perso est bien plus véloce :-(

En pratique, voici le code, et j'ai une erreur 1004 sur la ligne
Sh.Range("B" & Ligne) = .Name

Je suis confus
J@@

'****
Sub RecupDonnees()
Dim Feuille As Worksheet
Dim Sh As Worksheet
Dim Ligne As Long
Set Sh = Worksheets("Etat")
Ligne = Sh.Range("B100").End(xlUp)(2).Value
Sh.Select
ActiveSheet.Unprotect
Range("B5:N58").ClearContents

Application.ScreenUpdating = False
ModeRecalcul = Application.Calculation
Application.Calculation = xlCalculationManual
ActivationEvents = Application.EnableEvents
Application.EnableEvents = False

For Each Feuille In ActiveWorkbook.Worksheets
If Feuille.Name <> "ALIRE" _
And Feuille.Name <> "Etat" Then
With Feuille
Sh.Range("B" & Ligne) = .Name
Sh.Range("C" & Ligne) = .Range("B27")
Sh.Range("D" & Ligne) = .Range("B29")
Sh.Range("E" & Ligne) = .Range("B28")
Sh.Range("F" & Ligne) = .Range("B31")
Sh.Range("G" & Ligne) = .Range("C27")
Sh.Range("H" & Ligne) = .Range("C29")
Sh.Range("I" & Ligne) = .Range("C28")
Sh.Range("J" & Ligne) = .Range("C33")
Sh.Range("K" & Ligne) = .Range("D27")
Sh.Range("L" & Ligne) = .Range("D29")
Sh.Range("M" & Ligne) = .Range("D28")
Sh.Range("N" & Ligne) = .Range("D33")
End With
End If
Next Feuille

Application.EnableEvents = ActivationEvents
Application.Calculation = ModeRecalcul

ActiveSheet.Protect

End Sub
'***

MichDenis wrote:

| Peux-tu, stp, reposter?

3 suggestions :
A )
Cette syntaxe est supérieur en rapidité à ceci :
..[B27] -> tu devrais utiliser ce type de syntaxe .Range("B27")

B ) Si tes enregistrements ont lieu sur la même ligne pour tous les
éléments d'une même boucle, pourquoi ne pas utiliser une variable
au lieu de réévaluer la cellule suivante disponible sur la colonne

Dim Ligne as Long
Ligne = Worksheets("Etat").Range("B100").End(xlUp)(2).Value
Et pour tes écritures dans la boucle pour chacun des items :
Worksheets("Etat").Range("B" & ligne) = .Name

C ) Remplace Worksheets("Etat"). par une variable
dim Sh as Worksheet
Set Sh = Worksheets("Etat")
Et dans ton code, tu remplaces ceci
Worksheets("Etat").Range("B100").End(xlUp)(2).Value = .Name
Par
Sh.Range("B" & ligne) = .Name

Bonjour MichDenis
J'ai fait une petite modif car tout se copiait sur la même ligne.
Voici le résultat, qui fonctionne, mais si le code est plus agréable à lire, le
gain de temps n'est pas net. D'un autre côté récupérer 600 données en 13
secondes, faut pas se plaindre que la mariée est trop belle ;-)
Faudra que je vois au travail sur mon ordi à vapeur ce que cela donne.
Encore merci
Comme (ne) dirait (pas) JPS, c'est en manipulant (du code) qu'on devient
manipuleron.
@+
J@@

'****
Private Sub CommandButton1_Click()
Dim Feuille As Worksheet
Dim Sh As Worksheet
Dim Ligne As Long
Set Sh = Worksheets("Etat")
Sh.Select
' ActiveSheet.Unprotect
Range("B5:N60").ClearContents
Ligne = Sh.Range("B100").End(xlUp)(0).Row

'Application.ScreenUpdating = False
'ModeRecalcul = Application.Calculation
Application.Calculation = xlCalculationManual
ActivationEvents = Application.EnableEvents
Application.EnableEvents = False

For Each Feuille In ActiveWorkbook.Worksheets
Ligne = Ligne + 1 ''''''''la modif
If Feuille.Name <> "ALIRE" _
And Feuille.Name <> "Etat" Then
With Feuille
Sh.Range("B" & Ligne) = .Name
Sh.Range("C" & Ligne) = .Range("B27")
Sh.Range("D" & Ligne) = .Range("B29")
'''''etc etc
End With
End If
Next Feuille

Application.EnableEvents = ActivationEvents
'Application.Calculation = ModeRecalcul
Application.Calculation = xlCalculationAutomatic

Selection.SpecialCells(xlCellTypeConstants, 16).ClearContents
' ActiveSheet.Protect
Range("a3").Select
End Sub
'****

MichDenis wrote:

Tu remplaces cette ligne de code :

Ligne = Sh.Range("B100").End(xlUp)(2).Value

Par
Ligne = Sh.Range("B100").End(xlUp)(2).Row

ça bloque sur cette ligne :
Sh.Range("B" & Ligne) = .Name

Par la variable Ligne = 0 et que dans excel
il n'y a aucune ligne portant le numéro 0

"J@@"
voici le code, et j'ai une erreur 1004 sur la ligne
Sh.Range("B" & Ligne) = .Name

'****
Sub RecupDonnees()
Dim Feuille As Worksheet
Dim Sh As Worksheet
Dim Ligne As Long
Set Sh = Worksheets("Etat")
Ligne = Sh.Range("B100").End(xlUp)(2).Value
Sh.Select
ActiveSheet.Unprotect
Range("B5:N58").ClearContents

Application.ScreenUpdating = False
ModeRecalcul = Application.Calculation
Application.Calculation = xlCalculationManual
ActivationEvents = Application.EnableEvents
Application.EnableEvents = False

For Each Feuille In ActiveWorkbook.Worksheets
If Feuille.Name <> "ALIRE" _
And Feuille.Name <> "Etat" Then
With Feuille
Sh.Range("B" & Ligne) = .Name
Sh.Range("C" & Ligne) = .Range("B27")
Sh.Range("D" & Ligne) = .Range("B29")
''''etc
End With
End If
Next Feuille

Application.EnableEvents = ActivationEvents
Application.Calculation = ModeRecalcul

ActiveSheet.Protect
End Sub
'***

MichDenis wrote:

3 suggestions :
A )
Cette syntaxe est supérieur en rapidité à ceci :
..[B27] -> tu devrais utiliser ce type de syntaxe .Range("B27")

B ) Si tes enregistrements ont lieu sur la même ligne pour tous les
éléments d'une même boucle, pourquoi ne pas utiliser une variable
au lieu de réévaluer la cellule suivante disponible sur la colonne

Dim Ligne as Long
Ligne = Worksheets("Etat").Range("B100").End(xlUp)(2).Value
Et pour tes écritures dans la boucle pour chacun des items :
Worksheets("Etat").Range("B" & ligne) = .Name

C ) Remplace Worksheets("Etat"). par une variable
dim Sh as Worksheet
Set Sh = Worksheets("Etat")
Et dans ton code, tu remplaces ceci
Worksheets("Etat").Range("B100").End(xlUp)(2).Value = .Name
Par
Sh.Range("B" & ligne) = .Name

:-)))
et c'est en scudant les pauv' vieux qu'on devient scuderon
jps

"J@@" <jipivert@-ifrance.com> a écrit dans le message de news:
%23w7Lmp1NHHA.780@TK2MSFTNGP03.phx.gbl...

Bonjour MichDenis
J'ai fait une petite modif car tout se copiait sur la même ligne.
Voici le résultat, qui fonctionne, mais si le code est plus agréable à
lire, le gain de temps n'est pas net. D'un autre côté récupérer 600
données en 13 secondes, faut pas se plaindre que la mariée est trop belle
;-)
Faudra que je vois au travail sur mon ordi à vapeur ce que cela donne.
Encore merci
Comme (ne) dirait (pas) JPS, c'est en manipulant (du code) qu'on devient
manipuleron.
@+
J@@

'****
Private Sub CommandButton1_Click()
Dim Feuille As Worksheet
Dim Sh As Worksheet
Dim Ligne As Long
Set Sh = Worksheets("Etat")
Sh.Select
' ActiveSheet.Unprotect
Range("B5:N60").ClearContents
Ligne = Sh.Range("B100").End(xlUp)(0).Row

'Application.ScreenUpdating = False
'ModeRecalcul = Application.Calculation
Application.Calculation = xlCalculationManual
ActivationEvents = Application.EnableEvents
Application.EnableEvents = False

For Each Feuille In ActiveWorkbook.Worksheets
Ligne = Ligne + 1 ''''''''la modif
If Feuille.Name <> "ALIRE" _
And Feuille.Name <> "Etat" Then
With Feuille
Sh.Range("B" & Ligne) = .Name
Sh.Range("C" & Ligne) = .Range("B27")
Sh.Range("D" & Ligne) = .Range("B29")
'''''etc etc
End With
End If
Next Feuille

Application.EnableEvents = ActivationEvents
'Application.Calculation = ModeRecalcul
Application.Calculation = xlCalculationAutomatic

Selection.SpecialCells(xlCellTypeConstants, 16).ClearContents
' ActiveSheet.Protect
Range("a3").Select
End Sub
'****

MichDenis wrote:

Tu remplaces cette ligne de code :

Ligne = Sh.Range("B100").End(xlUp)(2).Value

Par
Ligne = Sh.Range("B100").End(xlUp)(2).Row

ça bloque sur cette ligne :
Sh.Range("B" & Ligne) = .Name

Par la variable Ligne = 0 et que dans excel
il n'y a aucune ligne portant le numéro 0

"J@@" voici le code, et j'ai une erreur 1004 sur la ligne
Sh.Range("B" & Ligne) = .Name

'****
Sub RecupDonnees()
Dim Feuille As Worksheet
Dim Sh As Worksheet
Dim Ligne As Long
Set Sh = Worksheets("Etat")
Ligne = Sh.Range("B100").End(xlUp)(2).Value
Sh.Select
ActiveSheet.Unprotect
Range("B5:N58").ClearContents

Application.ScreenUpdating = False
ModeRecalcul = Application.Calculation
Application.Calculation = xlCalculationManual
ActivationEvents = Application.EnableEvents
Application.EnableEvents = False

For Each Feuille In ActiveWorkbook.Worksheets
If Feuille.Name <> "ALIRE" _
And Feuille.Name <> "Etat" Then
With Feuille
Sh.Range("B" & Ligne) = .Name
Sh.Range("C" & Ligne) = .Range("B27")
Sh.Range("D" & Ligne) = .Range("B29")
''''etc
End With
End If
Next Feuille

Application.EnableEvents = ActivationEvents
Application.Calculation = ModeRecalcul

ActiveSheet.Protect
End Sub
'***

MichDenis wrote:

3 suggestions :
A )
Cette syntaxe est supérieur en rapidité à ceci :
..[B27] -> tu devrais utiliser ce type de syntaxe .Range("B27")

B ) Si tes enregistrements ont lieu sur la même ligne pour tous les
éléments d'une même boucle, pourquoi ne pas utiliser une variable
au lieu de réévaluer la cellule suivante disponible sur la colonne

Dim Ligne as Long
Ligne = Worksheets("Etat").Range("B100").End(xlUp)(2).Value
Et pour tes écritures dans la boucle pour chacun des items :
Worksheets("Etat").Range("B" & ligne) = .Name

C ) Remplace Worksheets("Etat"). par une variable
dim Sh as Worksheet
Set Sh = Worksheets("Etat")
Et dans ton code, tu remplaces ceci
Worksheets("Etat").Range("B100").End(xlUp)(2).Value = .Name
Par
Sh.Range("B" & ligne) = .Name