Problème de boucles - VBA

Bonsoir Patrick,
Essaie ceci pour voir ( à mettre dans un module standard )
A adapter bien sûr

Sub zzz()
Dim wsEnCours As Worksheet
Application.ScreenUpdating = False

For Feuille = 1 To ThisWorkbook.Sheets.Count - 1
If Sheets(Feuille).Name <> "Total" Then
Sheets(Feuille).Select
Set wsEnCours = ActiveSheet
Fcol = 1
TLig = 2 + 11 * (Feuille - 1)

For i = 1 To 17
Flig = 2 + 11 * (i - 1)
Range("A" & Flig & ":D" & Flig + 8).Copy
Sheets("Total").Activate
Cells(TLig, Fcol).Select
ActiveSheet.Paste
Fcol = Fcol + 5
wsEnCours.Select
Next i
End If
Next Feuille
Sheets("Total").Select
Cells(1, 1).Select
Application.ScreenUpdating = True
End Sub

--
Pounet95
on trouve tout ( ou presque ) http://www.excelabo.net/

"Patrick BASTARD" <pasdespambastardp@freepasdespam.fr> a écrit dans le
message de news: %23xjFsKl%23EHA.4028@TK2MSFTNGP15.phx.gbl...

Bonjour à tous.

Grand merci à qui voudra bien m'aider à modifier ce code pour qu'il copie
chacune des 17 zones (A2:D10, A13:D21, ...) d'un nombre de feuilles entre
28 et 31 (suivant les mois) sur la feuille "TOTAL", de manière à ce que
les premières (A2:D10) soient les unes sous les autres à partir de la
cellule A2, les deuxièmes les unes sous les autres à partir de la cellule
F2, etc...
Un titre est déja inscrit dans les cellules de la ligne 1.

J'ai pensé à une boucle pour décaler chaque zone à copier (en la
définissant avec offset? ) mais ça dépasse mes connaissances actuelles.

Question subsidiaire :
Dans un cas comme celui-ci, est-il plus judicieux de traiter chaque zone
de la première feuille, puis de la suivante, ou bien la première zone de
chaque feuille, puis la zone suivante?

Bien cordialement,

Patrick.

Sub Recopie()

For f = 1 To 8
'modifier pour compter le nb réel de feuilles dans le classeur(-1 pour
"TOTAL")

ThisWorkbook.Worksheets(ThisWorkbook.ActiveSheet.Index + f).Select
Range("A2:D10").Copy
Sheets("TOTAL").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues
'ici, la sélection se fait sur "TOTAL", et non sur la bonne feuille
Range("A13:D21").Copy
Sheets("TOTAL").Select
Range("f65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues

Next f

Range("A1:I1").Select
Selection.AutoFilter
End Sub

Salut Patrick,
ceci devrai faire l'affaire
les colonnes A et F doivent avoir au moins une donnée

Application.ScreenUpdating = False
For k = 1 To Sheets.Count
If Sheets(k).Name <> "TOTAL" Then
Sheets(k).Select
Sheets(k).Range("A2:D10").Copy
Sheets("TOTAL").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets(k).Select
Sheets(k).Range("A13:D21").Copy
Sheets("TOTAL").Select
Range("f65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues
End If
Next
Application.ScreenUpdating = True

Bruno
"Patrick BASTARD" <pasdespambastardp@freepasdespam.fr> a écrit dans le
message news: #xjFsKl#EHA.4028@TK2MSFTNGP15.phx.gbl...

Bonjour à tous.

Grand merci à qui voudra bien m'aider à modifier ce code pour qu'il copie
chacune des 17 zones (A2:D10, A13:D21, ...) d'un nombre de feuilles entre
28

et 31 (suivant les mois) sur la feuille "TOTAL", de manière à ce que les
premières (A2:D10) soient les unes sous les autres à partir de la cellule
A2, les deuxièmes les unes sous les autres à partir de la cellule F2,
etc...

Un titre est déja inscrit dans les cellules de la ligne 1.

J'ai pensé à une boucle pour décaler chaque zone à copier (en la
définissant

avec offset? ) mais ça dépasse mes connaissances actuelles.

Question subsidiaire :
Dans un cas comme celui-ci, est-il plus judicieux de traiter chaque zone
de

la première feuille, puis de la suivante, ou bien la première zone de
chaque

feuille, puis la zone suivante?

Bien cordialement,

Patrick.

Sub Recopie()

For f = 1 To 8
'modifier pour compter le nb réel de feuilles dans le classeur(-1 pour
"TOTAL")

ThisWorkbook.Worksheets(ThisWorkbook.ActiveSheet.Index + f).Select
Range("A2:D10").Copy
Sheets("TOTAL").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues
'ici, la sélection se fait sur "TOTAL", et non sur la bonne feuille
Range("A13:D21").Copy
Sheets("TOTAL").Select
Range("f65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues

Next f

Range("A1:I1").Select
Selection.AutoFilter
End Sub

Bonjour, *Pounet95*
J'ai lu ton post Ot1A$rl%23EHA.1084@tk2msftngp13.phx.gbl
avec le plus grand intéret :

Ton code, adapté comme ci-dessous, me convient parfaitement :
- Il semble que le -1 de "For Feuille = 1 To ThisWorkbook.Sheets.Count - 1"
fausse tout, mais je n'ai pas compris pourquoi.

- Le 9 à la place du 11, parce qu'en fait il n'y a que 9 lignes à copier
- Cells(TLig - 9) pour commencer sur la 2° ligne, sinon, début en ligne 11
- Range("A" & Flig & ":" & "D" & Flig + 8).Copy (Je me suis posé la question
sur ton ":D" qui passe mal par OE ;-) )

Je te remercie sincèrement.

Bien cordialement,

Patrick.


Sub zzz()
Dim wsEnCours As Worksheet
Application.ScreenUpdating = False

For Feuille = 1 To ThisWorkbook.Sheets.Count '- 1
If Sheets(Feuille).Name <> "TOTAL" Then
Sheets(Feuille).Select
Set wsEnCours = ActiveSheet
Fcol = 1
TLig = 2 + 9 * (Feuille - 1)

For i = 1 To 17
Flig = 2 + 9 * (i - 1)
Range("A" & Flig & ":" & "D" & Flig + 8).Copy
Sheets("Total").Activate
Cells(TLig - 9, Fcol).Select
Selection.PasteSpecial Paste:=xlPasteValues
'ActiveSheet.Paste
Fcol = Fcol + 5
wsEnCours.Select
Next i
End If
Next Feuille
Sheets("Total").Select
Range("A1:I1").Select
Selection.AutoFilter
Application.ScreenUpdating = True
End Sub

Bonsoir Patrick,
Essaie ceci pour voir ( à mettre dans un module standard )
A adapter bien sûr

Sub zzz()
Dim wsEnCours As Worksheet
Application.ScreenUpdating = False

For Feuille = 1 To ThisWorkbook.Sheets.Count - 1
If Sheets(Feuille).Name <> "Total" Then
Sheets(Feuille).Select
Set wsEnCours = ActiveSheet
Fcol = 1
TLig = 2 + 11 * (Feuille - 1)

For i = 1 To 17
Flig = 2 + 11 * (i - 1)
Range("A" & Flig & ":D" & Flig + 8).Copy
Sheets("Total").Activate
Cells(TLig, Fcol).Select
ActiveSheet.Paste
Fcol = Fcol + 5
wsEnCours.Select
Next i
End If
Next Feuille
Sheets("Total").Select
Cells(1, 1).Select
Application.ScreenUpdating = True
End Sub


"Patrick BASTARD" <pasdespambastardp@freepasdespam.fr> a écrit dans le
message de news: %23xjFsKl%23EHA.4028@TK2MSFTNGP15.phx.gbl...

Bonjour à tous.

Grand merci à qui voudra bien m'aider à modifier ce code pour qu'il
copie chacune des 17 zones (A2:D10, A13:D21, ...) d'un nombre de
feuilles entre 28 et 31 (suivant les mois) sur la feuille "TOTAL",
de manière à ce que les premières (A2:D10) soient les unes sous les
autres à partir de la cellule A2, les deuxièmes les unes sous les
autres à partir de la cellule F2, etc...
Un titre est déja inscrit dans les cellules de la ligne 1.

J'ai pensé à une boucle pour décaler chaque zone à copier (en la
définissant avec offset? ) mais ça dépasse mes connaissances
actuelles. Question subsidiaire :
Dans un cas comme celui-ci, est-il plus judicieux de traiter chaque
zone de la première feuille, puis de la suivante, ou bien la
première zone de chaque feuille, puis la zone suivante?

Bien cordialement,

Patrick.

Sub Recopie()

For f = 1 To 8
'modifier pour compter le nb réel de feuilles dans le classeur(-1
pour "TOTAL")

ThisWorkbook.Worksheets(ThisWorkbook.ActiveSheet.Index + f).Select
Range("A2:D10").Copy
Sheets("TOTAL").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues
'ici, la sélection se fait sur "TOTAL", et non sur la bonne feuille
Range("A13:D21").Copy
Sheets("TOTAL").Select
Range("f65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues

Next f

Range("A1:I1").Select
Selection.AutoFilter
End Sub

Bonsoir, *Bruno*

Je te remercie de t'être penché sur mon problème :

Le code que tu as eu la gentillesse de m'adresser fonctionne parfaitement.

Je le conserve pour une utilisation future où les zones à copier seraient de
taille différente, car pour de nombreuses zones de taille identique, le code
de Pounet95 est plus léger.

Encore Merci,

Bien cordialement,

Patrick.

Salut Patrick,
ceci devrai faire l'affaire
les colonnes A et F doivent avoir au moins une donnée

Application.ScreenUpdating = False
For k = 1 To Sheets.Count
If Sheets(k).Name <> "TOTAL" Then
Sheets(k).Select
Sheets(k).Range("A2:D10").Copy
Sheets("TOTAL").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets(k).Select
Sheets(k).Range("A13:D21").Copy
Sheets("TOTAL").Select
Range("f65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues
End If
Next
Application.ScreenUpdating = True

Bruno
"Patrick BASTARD" <pasdespambastardp@freepasdespam.fr> a écrit dans le
message news: #xjFsKl#EHA.4028@TK2MSFTNGP15.phx.gbl...

Bonjour à tous.

Grand merci à qui voudra bien m'aider à modifier ce code pour qu'il
copie chacune des 17 zones (A2:D10, A13:D21, ...) d'un nombre de
feuilles entre 28 et 31 (suivant les mois) sur la feuille "TOTAL",
de manière à ce que les premières (A2:D10) soient les unes sous les
autres à partir de la cellule A2, les deuxièmes les unes sous les
autres à partir de la cellule F2, etc... Un titre est déja inscrit
dans les cellules de la ligne 1.

J'ai pensé à une boucle pour décaler chaque zone à copier (en la
définissant avec offset? ) mais ça dépasse mes connaissances
actuelles.

Question subsidiaire :
Dans un cas comme celui-ci, est-il plus judicieux de traiter chaque
zone de la première feuille, puis de la suivante, ou bien la
première zone de chaque feuille, puis la zone suivante?

Bien cordialement,

Patrick.

Sub Recopie()

For f = 1 To 8
'modifier pour compter le nb réel de feuilles dans le classeur(-1
pour "TOTAL")

ThisWorkbook.Worksheets(ThisWorkbook.ActiveSheet.Index + f).Select
Range("A2:D10").Copy
Sheets("TOTAL").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues
'ici, la sélection se fait sur "TOTAL", et non sur la bonne feuille
Range("A13:D21").Copy
Sheets("TOTAL").Select
Range("f65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues

Next f

Range("A1:I1").Select
Selection.AutoFilter
End Sub

Re,
Tout le plaisir était pour moi. Et ce d'autant plus que les 'merci' se
perdent de plus en plus souvent
si j'en juge par la lecture des différents posts sur ce forum.
Bonne soirée

--
Pounet95
on trouve tout ( ou presque ) http://www.excelabo.net/

"Patrick BASTARD" <pasdespambastardp@freepasdespam.fr> a écrit dans le
message de news: OInAYSm%23EHA.4072@TK2MSFTNGP10.phx.gbl...

Bonjour, *Pounet95*
J'ai lu ton post Ot1A$rl%23EHA.1084@tk2msftngp13.phx.gbl
avec le plus grand intéret :

Ton code, adapté comme ci-dessous, me convient parfaitement :
- Il semble que le -1 de "For Feuille = 1 To ThisWorkbook.Sheets.Count -
1" fausse tout, mais je n'ai pas compris pourquoi.

- Le 9 à la place du 11, parce qu'en fait il n'y a que 9 lignes à copier
- Cells(TLig - 9) pour commencer sur la 2° ligne, sinon, début en ligne 11
- Range("A" & Flig & ":" & "D" & Flig + 8).Copy (Je me suis posé la
question sur ton ":D" qui passe mal par OE ;-) )

Je te remercie sincèrement.

Bien cordialement,

Patrick.


Sub zzz()
Dim wsEnCours As Worksheet
Application.ScreenUpdating = False

For Feuille = 1 To ThisWorkbook.Sheets.Count '- 1
If Sheets(Feuille).Name <> "TOTAL" Then
Sheets(Feuille).Select
Set wsEnCours = ActiveSheet
Fcol = 1
TLig = 2 + 9 * (Feuille - 1)

For i = 1 To 17
Flig = 2 + 9 * (i - 1)
Range("A" & Flig & ":" & "D" & Flig + 8).Copy
Sheets("Total").Activate
Cells(TLig - 9, Fcol).Select
Selection.PasteSpecial Paste:=xlPasteValues
'ActiveSheet.Paste
Fcol = Fcol + 5
wsEnCours.Select
Next i
End If
Next Feuille
Sheets("Total").Select
Range("A1:I1").Select
Selection.AutoFilter
Application.ScreenUpdating = True
End Sub

Bonsoir Patrick,
Essaie ceci pour voir ( à mettre dans un module standard )
A adapter bien sûr

Sub zzz()
Dim wsEnCours As Worksheet
Application.ScreenUpdating = False

For Feuille = 1 To ThisWorkbook.Sheets.Count - 1
If Sheets(Feuille).Name <> "Total" Then
Sheets(Feuille).Select
Set wsEnCours = ActiveSheet
Fcol = 1
TLig = 2 + 11 * (Feuille - 1)

For i = 1 To 17
Flig = 2 + 11 * (i - 1)
Range("A" & Flig & ":D" & Flig + 8).Copy
Sheets("Total").Activate
Cells(TLig, Fcol).Select
ActiveSheet.Paste
Fcol = Fcol + 5
wsEnCours.Select
Next i
End If
Next Feuille
Sheets("Total").Select
Cells(1, 1).Select
Application.ScreenUpdating = True
End Sub


"Patrick BASTARD" <pasdespambastardp@freepasdespam.fr> a écrit dans le
message de news: %23xjFsKl%23EHA.4028@TK2MSFTNGP15.phx.gbl...

Bonjour à tous.

Grand merci à qui voudra bien m'aider à modifier ce code pour qu'il
copie chacune des 17 zones (A2:D10, A13:D21, ...) d'un nombre de
feuilles entre 28 et 31 (suivant les mois) sur la feuille "TOTAL",
de manière à ce que les premières (A2:D10) soient les unes sous les
autres à partir de la cellule A2, les deuxièmes les unes sous les
autres à partir de la cellule F2, etc...
Un titre est déja inscrit dans les cellules de la ligne 1.

J'ai pensé à une boucle pour décaler chaque zone à copier (en la
définissant avec offset? ) mais ça dépasse mes connaissances
actuelles. Question subsidiaire :
Dans un cas comme celui-ci, est-il plus judicieux de traiter chaque
zone de la première feuille, puis de la suivante, ou bien la
première zone de chaque feuille, puis la zone suivante?

Bien cordialement,

Patrick.

Sub Recopie()

For f = 1 To 8
'modifier pour compter le nb réel de feuilles dans le classeur(-1
pour "TOTAL")

ThisWorkbook.Worksheets(ThisWorkbook.ActiveSheet.Index + f).Select
Range("A2:D10").Copy
Sheets("TOTAL").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues
'ici, la sélection se fait sur "TOTAL", et non sur la bonne feuille
Range("A13:D21").Copy
Sheets("TOTAL").Select
Range("f65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues

Next f

Range("A1:I1").Select
Selection.AutoFilter
End Sub

Bonsoir Patrick,

Désolé d'arriver après la bataille ;-((

Je voulais juste apporter une précision importante, selon moi : c'est en
général une mauvaise idée de sélectionner les différentes feuilles
d'un classeur et les plages de cellules pour y lire des valeurs ;
celles-ci sont accessibles par la propriété Value, et il est inutile
d'être sur la feuille concernée pour les lire.

De même Copier/Coller est une méthode naturelle quand on fait les choses
manuellement, mais souvent inutile par macro ; on peut écrire en effet :

Range("Destination").Value = Range("Source").Value

"Destination" et "Source" devant être des plages de même taille.

Value étant la propriété par défaut d'un objet Range, on peut simplifier
ainsi si "Destination" et "Source" ne comprennent qu'une cellule :

Range("Destination") = Range("Source")

Si "Destination" et "Source" comportent + d'une cellule, il faut
indiquer le second "Value" explicitement :

Range("Destination") = Range("Source").Value

Cette technique (absence de sélection et utilisation de la propriété
Value plutôt qu'emploi du Copier/Coller) accélère la vitesse de
traitement de façon notable, et permet d'avoir un code + compact.

Voici ce que je te propose (attention à rétablir les lignes coupées) :

Sub Report()
Dim i As Integer, j As Integer, FCol As Integer, TLig As Integer, FLig
As Integer, f As Worksheet
Application.ScreenUpdating = False
Sheets("TOTAL").Activate
For Each f In ThisWorkbook.Sheets
If f.Name <> "TOTAL" Then
FCol = 1
TLig = 2 + 9 * (i)
For j = 0 To 16
FLig = 2 + 9 * (j)
Range(Cells(TLig, FCol), Cells(TLig + 8,
FCol + 3)) = f.Range("A" & FLig & ":" & "D" & FLig + 8).Value
FCol = FCol + 5
Next
End If
i = i + 1
Next f
End Sub

Cela recommence ;-(( Message encore tronqué ; en voici la fin :

ben c'est pas mieux !
tu es sur qu tu n'as pas ms un truc qui limite la taille des messages
que tu envoies ;-)
j'ai jamais eu ce pb avec thunderbird sur PC... Ah les macs (vieux débat !)

Misange migrateuse http://www.excelabo.net
mail : http://cerbermail.com/?k5Q8Dh2mta

Le 15/01/2005 11:57, :

Cela recommence ;-(( Message encore tronqué ; en voici la fin :

Bonjour Michel,
Vu d'ici ça semblait complet.
Même ton message a été optimisé ? ;o)))

--
Pounet95
on trouve tout ( ou presque ) http://www.excelabo.net/

"Michel Gaboly" <michel.gaboly@wanadoo.fr> a écrit dans le message de news:
On$3SEv%23EHA.3368@TK2MSFTNGP15.phx.gbl...

Cela recommence ;-(( Message encore tronqué ; en voici la fin :

Bonjour Misange,

Effectivement, ;-((

Bonne année.

Rien fait de particulier. Ce qui est surprenant, c'est que quand un
messgae est tronqué, il ne semble pas y avoir de constante (nb de lignes
par exemple).

J'utilisais avant Nescape Communicator 4.5, une antiquité, l'ancêtre de
Thunderbird. Jamais eu ce problème.


Nouvelle tentative de poster la fin.

Par ailleurs, pour parcourir une collection , il y a la boucle "For ...
Each" qui est extrêmement pratique, qui le + souvent, remplace
avantageusement "For i = ... to Collection.Count".

NB - C'est moins vrai ici, dans la mesure où on a besoin d'un compteur
pour incrémenter TLig.

Voilà ;-))

ben c'est pas mieux !
tu es sur qu tu n'as pas ms un truc qui limite la taille des messages
que tu envoies ;-)
j'ai jamais eu ce pb avec thunderbird sur PC... Ah les macs (vieux débat !)

Misange migrateuse http://www.excelabo.net
mail : http://cerbermail.com/?k5Q8Dh2mta

Le 15/01/2005 11:57, :

Cela recommence ;-(( Message encore tronqué ; en voici la fin :

--
Cordialement,

Michel Gaboly
www.gaboly.com