copier lignes choisies les coller en bas sur plusieurs feuilles

marskng

XLDnaute Nouveau
Bonsoir
j'ai besoin d'aide s'il vous plait.
En fait, j'ai des variables à utiliser pour faire des formules avec, donc j'ai colorié en jaune les lignes de mes variables sur plusieurs feuilles , après pour répéter les manipulations avec ces variables sur plusieurs feuilles(faire sélectionner toutes les feuilles et effectuer mes formules), je voudrais copier les lignes jaunes en question, et les coller en bas de chaque feuille à la ligne 920 .
j'ai laissé un fichier joint avec un modèle réduit de mon classeur , en fait je veux reproduire ce qui a été fait dans la feuille 1 sur toutes les feuilles, soit copier les lignes jaunes ,les coller à partir de la ligne 920 pour toutes les autres feuilles.
 

Pièces jointes

  • Classeur exple.xlsx
    268.3 KB · Affichages: 69
Dernière édition:

job75

XLDnaute Barbatruc
Re : copier lignes choisies les coller en bas sur plusieurs feuilles

Bonjour marskng,

Sur Excel 2007 et versions suivantes on peut filtrer les couleurs avec le filtre automatique :

Code:
Sub FiltrerCouleur()
Dim w As Worksheet, plage As Range
Application.ScreenUpdating = False
For Each w In Worksheets
  Set plage = w.[U:U] 'colonne à adapter éventuellement
  w.AutoFilterMode = False
  plage.AutoFilter 1, RGB(255, 255, 0), xlFilterCellColor 'filtre la couleur jaune
  Set plage = plage.SpecialCells(xlCellTypeVisible).EntireRow
  w.AutoFilterMode = False
  w.Rows("920:" & w.Rows.Count).Delete
  plage.Copy w.Rows(920)
  w.Rows(920).Delete
Next
End Sub
Le filtrage se fait sur la colonne U qui convient pour toutes les feuilles de votre fichier.

Copie des lignes filtrées sur la ligne 920 de chaque feuille, comme demandé.

A+
 
Dernière édition:

job75

XLDnaute Barbatruc
Re : copier lignes choisies les coller en bas sur plusieurs feuilles

Bonjour marskng, le forum,

Je n'avais pas bien testé hier.

Il faut limiter la colonne filtrée par le UsedRange de la feuille :

Code:
Sub FiltrerCouleur()
Dim w As Worksheet, plage As Range
Application.ScreenUpdating = False
For Each w In Worksheets
  Set plage = Intersect(w.[A:A], w.UsedRange.EntireRow)
  plage.AutoFilter 1, RGB(255, 255, 0), xlFilterCellColor 'filtre la couleur jaune
  Set plage = plage.SpecialCells(xlCellTypeVisible)
  w.AutoFilterMode = False
  w.Rows("920:" & w.Rows.Count).Delete
  plage.EntireRow.Copy w.Rows(920)
  w.Rows(920).Delete
Next
End Sub
Fichier joint.

A+
 

Pièces jointes

  • Classeur exple(1).xlsm
    278.2 KB · Affichages: 92

marskng

XLDnaute Nouveau
Re : copier lignes choisies les coller en bas sur plusieurs feuilles

Bonjour job75
merci mais normalement ça a marché dès le début avec le code que vous m'avez proposé en premier temps soit celui là:
Code:
Sub FiltrerCouleur()
Dim w As Worksheet, plage As Range
Application.ScreenUpdating = False
For Each w In Worksheets
  w.AutoFilterMode = False
  Set plage = w.UsedRange
  Set plage = w.Range("U1:U" & plage.Row + plage.Rows.Count)
  plage.AutoFilter 1, RGB(255, 255, 0), xlFilterCellColor 'filtre la couleur jaune
  Set plage = plage.SpecialCells(xlCellTypeVisible).EntireRow
  w.AutoFilterMode = False
  w.Rows("920:" & w.Rows.Count).Delete
  plage.Copy w.Rows(920)
  w.Rows(920).Delete
Next
End Sub

et votre dernier aussi a marché . merci encore une fois.
 

Discussions similaires

Réponses
8
Affichages
187
Réponses
10
Affichages
609

Statistiques des forums

Discussions
313 090
Messages
2 095 176
Membres
106 200
dernier inscrit
OCNAM