reproduire certaines lignes de toutes les feuilles sur une feuille.

Le
freedo
Bonjour à toutes et à Tous,
comment repcopier les Valeurs des lignes A10 à J75 (environ) de toutes
les feuilles du classeur en reportant ceux ci sur un nouvelle feuille.
En fait je vois cela comme ceci::
sur la nouvelle feuille :
à partir de A1 les valeurs de la première A10:J (ligne où il y a le
mot Prix en début de ligne dans la colonne A)
puis de A76 les valeurs de la deuxième feuille A10:J75
et ainsi de suite vers le bas afin de mettre les valeurs de toutes f+
ou - 150 feuilles)
certaines feuilles ont des plages plus étendues (66 à 80 lignes) donc
il serait souhaitable de copier jusque la ligne contenenant en colonne
A la valeur Prix en début de phrase.
Afin de pouvoir cerner le début de chaque groupe recopiée , mettre en
couleur le fond de la 1ère ligne recopiée.
Merci de suivre,
Freedo
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
FFO
Le #19577021
Salut à toi

Soit la feuille "Recopie" pour recopier les lignes
En colonne A de chaque feuille le mot "Prix" dans la cellule de la 1° ligne
à recopier

Je te propose ce code :

For i = 1 to Sheets.Count
If Sheets(i).Name <> "Recopie" Then
Ligne = Sheets("Recopie").Range("A65535").End(xlup).Row+1
On Error Resume Next
Début = Sheets(i).Range("A1", "A" &
Sheets(i).Range("A65535").End(xlUp).Row).Find(What:="Prix",
After:=Sheets(i).Range("A1"), LookIn:=xlValues, _
LookAt:=xlPart).Row
If Début <> "" Then
Sheets(i).Range("A" & Début, "J" &
Sheets(i).Range("A65535").End(xlup).Row).Copy Sheets("Recopie").Range("A" &
Ligne)
Sheets("Recopie").Range("A" & Ligne).Entirerow.Interior.Colorindex = 6
End If
End If
Début = ""
Next

La 1° ligne de chaque feuille est coloriée en jaune dans la feuille "Recopie"


Je n'ai pas testé !!!!

Fais des essais et dis moi !!!!!!
freedo
Le #19577521
On 16 juin, 11:06, FFO
Salut à toi

Soit la feuille "Recopie" pour recopier les lignes
En colonne A de chaque feuille le mot "Prix" dans la cellule de la 1° l igne
à recopier

Je te propose ce code :

For i = 1 to Sheets.Count
If Sheets(i).Name <> "Recopie" Then
Ligne = Sheets("Recopie").Range("A65535").End(xlup).Row+1
On Error Resume Next
 Début = Sheets(i).Range("A1", "A" &
Sheets(i).Range("A65535").End(xlUp).Row).Find(What:="Prix",
After:=Sheets(i).Range("A1"), LookIn:=xlValues, _
        LookAt:=xlPart).Row
If Début <> "" Then
Sheets(i).Range("A" & Début, "J" &
Sheets(i).Range("A65535").End(xlup).Row).Copy Sheets("Recopie").Range("A" &
Ligne)
Sheets("Recopie").Range("A" & Ligne).Entirerow.Interior.Colorindex = 6
End If
End If
Début = ""
Next

La 1° ligne de chaque feuille est coloriée en jaune dans la feuille " Recopie"

Je n'ai pas testé !!!!

Fais des essais et dis moi !!!!!!



Bonjour,
la recopie se fait dans le mauvais sens
en fait la macro recopie tout ce qui après la ligne où dans la colonne
A se trouve le mot Prix
ors il faut recopier tout ce qui est de A10 jusque la ligne ou il ya
lela première fois le mot Prix.
merci de corriger
Freedo
FFO
Le #19579101
Rebonjour à toi

Mille excuses pour cette incompréhension dans ta demande

Voici donc mon code modifié conformément à ton souhait j'espère !!!!!

For i = 1 to Sheets.Count
If Sheets(i).Name <> "Recopie" Then
Ligne = Sheets("Recopie").Range("A65535").End(xlup).Row+1
On Error Resume Next
Fin = Sheets(i).Range("A1", "A" &
Sheets(i).Range("A65535").End(xlUp).Row).Find(What:="Prix",
After:=Sheets(i).Range("A1"), LookIn:=xlValues, _
LookAt:=xlPart).Row
If Fin <> "" Then
Sheets(i).Range("A10", "J" & Fin).Copy Sheets("Recopie").Range("A" &
Ligne)
Sheets("Recopie").Range("A" & Ligne).Entirerow.Interior.Colorindex = 6
End If
End If
Fin = ""
Next

Fais des essais et dis moi !!!!!
freedo
Le #19583661
On 16 juin, 16:02, FFO
Rebonjour à toi

Mille excuses pour cette incompréhension dans ta demande

Voici donc mon code modifié conformément à ton souhait j'espère ! !!!!

For i = 1 to Sheets.Count
If Sheets(i).Name <> "Recopie" Then
Ligne = Sheets("Recopie").Range("A65535").End(xlup).Row+1
On Error Resume Next
Fin = Sheets(i).Range("A1", "A" &
Sheets(i).Range("A65535").End(xlUp).Row).Find(What:="Prix",
After:=Sheets(i).Range("A1"), LookIn:=xlValues, _
LookAt:=xlPart).Row
If Fin <> "" Then
Sheets(i).Range("A10", "J" & Fin).Copy Sheets("Recopie").Range("A" &
Ligne)
Sheets("Recopie").Range("A" & Ligne).Entirerow.Interior.Colorindex = 6
End If
End If
Fin = ""
Next

Fais des essais et dis moi !!!!!



Rebonjour FFO,
j'ai essayé de répondre tout de suite mais le site est resté
inacessible quelque temps ce 16juin, mais voici ma réponse,
Ok , les lignes nécessaires sont bien reprises mais il faudrait faire
une copie "valeurs" des cellules
car les résultats de certaines cellules sont en erreur du fait de
liens par les formules qui pointent vers d'autres cellules qui
ne sont pas comprises dans la plage de lignes recopiées.
D'autre part , si c'était possible, y a t il moyen de reprendre
également le nom de la feuille sur la première ligne copiée ? (par
exemple en colonne K.)
merci beaucoup pour ton aide
freedo
FFO
Le #19584631
Rebonjour à toi

Content que celà te convienne

Pour la recopie que des valeurs change la ligne :

Sheets(i).Range("A10", "J" & Fin).Copy Sheets("Recopie").Range("A" & Ligne)

Par

Sheets("Recopie").Range("A" & Ligne, "J" & Ligne+(Fin-10)).Value =
Sheets(i).Range("A10", "J" & Fin).Value

Pour récupérer le nom en colonne K de la 1° ligne à recopier (K10 de chaque
feuille) rajoute cette ligne :

Sheets("Recopie").Range("K" & Ligne).Value = Sheets(i).Range("K10).Value

Mets ces 2 lignes l'une aprés l'autre ainsi :

Sheets("Recopie").Range("A" & Ligne, "J" & Ligne+(Fin-10)).Value =
Sheets(i).Range("A10", "J" & Fin).Value
Sheets("Recopie").Range("K" & Ligne).Value = Sheets(i).Range("K10).Value

Celà devrait te convenir

Dis moi !!!!!
freedo
Le #19584901
On 17 juin, 10:41, FFO
Rebonjour à toi

Content que celà te convienne

Pour la recopie que des valeurs change la ligne :

 Sheets(i).Range("A10", "J" & Fin).Copy Sheets("Recopie").Range("A" & L igne)

Par

Sheets("Recopie").Range("A" & Ligne, "J" & Ligne+(Fin-10)).Value =
Sheets(i).Range("A10", "J" & Fin).Value

Pour récupérer le nom en colonne K de la 1° ligne à recopier (K10 de chaque
feuille) rajoute cette ligne :

Sheets("Recopie").Range("K" & Ligne).Value = Sheets(i).Range("K10).Valu e

Mets ces 2 lignes l'une aprés l'autre ainsi :

Sheets("Recopie").Range("A" & Ligne, "J" & Ligne+(Fin-10)).Value =
Sheets(i).Range("A10", "J" & Fin).Value
Sheets("Recopie").Range("K" & Ligne).Value = Sheets(i).Range("K10).Valu e

Celà devrait te convenir

Dis moi !!!!!



Nickel ! Ok c'est bon sauf pour le nom de la feuille ( c'est à dire le
nom de l'onglet ) et non la valeur du K10 de chaque feuille.
Vu le dernier traitement que tu as paufiné le nom de l'onglet
pourrazit se mettre en colonne B de chaque début d'enregistrement au
lieu de colonne K.
Après tout çà j'ai un traitement Nikel chrome
Un très grand MERCI à toi pout ta patience,
freedo.
freedo
Le #19585991
On 17 juin, 10:41, FFO
Rebonjour à toi

Content que celà te convienne

Pour la recopie que des valeurs change la ligne :

 Sheets(i).Range("A10", "J" & Fin).Copy Sheets("Recopie").Range("A" & L igne)

Par

Sheets("Recopie").Range("A" & Ligne, "J" & Ligne+(Fin-10)).Value =
Sheets(i).Range("A10", "J" & Fin).Value

Pour récupérer le nom en colonne K de la 1° ligne à recopier (K10 de chaque
feuille) rajoute cette ligne :

Sheets("Recopie").Range("K" & Ligne).Value = Sheets(i).Range("K10).Valu e

Mets ces 2 lignes l'une aprés l'autre ainsi :

Sheets("Recopie").Range("A" & Ligne, "J" & Ligne+(Fin-10)).Value =
Sheets(i).Range("A10", "J" & Fin).Value
Sheets("Recopie").Range("K" & Ligne).Value = Sheets(i).Range("K10).Valu e

Celà devrait te convenir

Dis moi !!!!!



à l'attention de FFO,
Impec le traitement je récupère plus de 7000 lignes en +-20secondes
sur 150 feuilles différentes.
NB: C'est bon ne cherche plus j'ai trouvé pour mettre le nom de la
feuille à la bonne place;
merci pour tout
freedo
FFO
Le #19586901
Rebonjour à toi

Content de t'avoir satisfait

Pour le nom de l'onglet en colonne K de la feuille "Recopie" tu peux mettre
cette ligne :

Sheets("Recopie").Range("K" & Ligne).Value = Sheets(i).Name

Ce qui donne ces 2 lignes :

Sheets("Recopie").Range("A" & Ligne, "J" & Ligne+(Fin-10)).Value =
Sheets(i).Range("A10", "J" & Fin).Value
Sheets("Recopie").Range("K" & Ligne).Value = Sheets(i).Name

Celà devrait convenir

Dis moi !!!!
freedo
Le #19587231
On 17 juin, 15:22, FFO
Rebonjour à toi

Content de t'avoir satisfait

Pour le nom de l'onglet en colonne K de la feuille "Recopie" tu peux mett re
cette ligne :

Sheets("Recopie").Range("K" & Ligne).Value = Sheets(i).Name

Ce qui donne ces 2 lignes :

 Sheets("Recopie").Range("A" & Ligne, "J" & Ligne+(Fin-10)).Value =
Sheets(i).Range("A10", "J" & Fin).Value
Sheets("Recopie").Range("K" & Ligne).Value = Sheets(i).Name

Celà devrait convenir

Dis moi !!!!



Tout est bon
et de nouveau, Un très grand MERCI à toi pour tes conseils et ta
patience,
freedo.
Publicité
Poster une réponse
Anonyme