Astuces Excel
  1. Astuces Excel
  3. Copier toutes les rangées de données complètent la couleur à la nouvelle feuille
Intereting Posts
Xlsxwriter différents formats aux différentes cellules dans la même colonne Ouvrez un classur Excel dans un autre classur Excel, puis remplissez un formulaire dans ce classur Foreach loop from array et comment le contenir Convertir en string supprime 0 après décimal En excel sélectionner des lignes par variables Comment puis-je extraire du text d'une cellule dans une feuille différente si la cellule à deux colonnes contient un text spécifique? Transposer datatables en remplissant la première colonne Excel Userform ne démarre pas après la première charge En utilisant simplemail à Haskell lance une erreur de tuyau cassé Excel Macro VBA pour créer un hyperlink vers une autre feuille en fonction du contenu de la cellule active Le formatting conditionnel ne fonctionne pas ou la formule est incorrecte Variable globale de feuille de calcul pour userform en excel Validation des données Remplissez la cellule vidée avec la list Ouverture d'Excel à partir d'Access, erreur 91 après la première exécution réussie Comment puis-je créer un tableau basé sur une fonction IF

Copier toutes les rangées de données complètent la couleur à la nouvelle feuille

J'ai une longue feuille de calcul qui est toujours mise à jour. Une fois la tâche terminée, la rangée de données sera remplie avec la couleur standard verte. Je veux pouvoir coder une macro qui peut prendre toutes les lignes remplies avec la couleur verte de la feuille actuelle et les coller sur une nouvelle feuille? Des idées?

Si cela aide, les nombres de lignes ne sont pas constants, ils changent toujours. Le nombre de lignes remplies de vert ne sont pas toujours les mêmes.

Peut-être que vous pouvez modifier le code ci-dessous selon vos besoins. 

Sub CopyGreenColoredRows() Dim wsSource As Worksheet, wsDest As Worksheet Dim i As Long, lr As Long, lc As Long, dlr As Long Application.ScreenUpdating = False Set wsSource = Sheets("Sheet1") 'Source sheet with colored rows/Sheet to copy data from Set wsDest = Sheets("Sheet2") 'Destination Sheet/copy the data to 'Clearing the destination sheet excluding headers before pasting new data 'Remove this line if not required wsDest.UsedRange.Offset(1).Clear lr = wsSource.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row lc = wsSource.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column With wsSource 'Assuming Row1 is the header row For i = 2 To lr 'The code assumes that the color applied is through the conditional formatting If .Range("A" & i).DisplayFormat.Interior.Color = 5287936 Then dlr = wsDest.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1 .Range("A" & i, .Cells(i, lc)).Copy wsDest.Range("A" & dlr) End If Next i End With Application.ScreenUpdating = True End Sub

Le code ci-dessous fait ce que vous avez décrit. Notez dans le file .gif animé que Sheet2 démarre en blanc puis, lorsque vous l'exécutez, les lignes vert sont copiées. Bien sûr, vous devrez modifier votre situation exacte.

entrez la description de l'image ici 

 Option Explicit Sub transferGreen() Dim sourceSh As Worksheet, destSh As Worksheet Dim cell As Range, sourceR As Range, destR As Range Set sourceSh = Worksheets("Sheet1") Set sourceR = sourceSh.Range("A1") Set sourceR = sourceSh.Range(sourceR, sourceR.End(xlDown)) Set destSh = Worksheets("Sheet2") Set destR = destSh.Range("A1") If destR.Offset(1, 0) <> "" Then Set destR = destR.End(xlDown).Offset(1, 0) sourceR.Select destSh.Activate For Each cell In sourceR If cell.Interior.Color = 5287936 Then sourceSh.Rows(cell.row).Copy destSh.Rows(destR.row).Select destSh.Paste Set destR = destR.Offset(1, 0) End If Next End Sub