Rutina para filtrar por colores

Necesito una rutina para ejecutar una macro excel que me filtre por color, no un color determinado, sino todos los que haya en la columna, incluido el "sin color". La columna y fila donde colocar el filtro siempre es la misma y el color no es del formato condicional. Una vez filtradas las celdas por uno de los colores, la rutina copia las celdas filtradas y las pega en otra hoja (siempre la misma hoja.

Es decir, debe filtrar, por un color de los que hay en la columna, copiar celdas filtradas y pegar en otra hoja, después volver a la hoja inicial, filtrar por otro color, copiar y pegar, y así con todos los colores de la columna, sean 1 o 101.

Hasta ahora, he utilizado una rutina sencilla que funciona determinando una instrucción para cada color a filtrar, pero cada vez hay mas colores, además de que existe el riesgo de que haya un error al "pintar" la celda y que el color no sea el mismo. Además, para usar esta rutina necesito que para copiar el rango no haya celdas vacías y eso también es un riesgo.

Esta es parte de la rutina que se repite para cada color establecido incluido el "sin relleno":

Range("d1").Select
Selection.AutoFilter Field:=4, Criteria1:=RGB(255, 0 _
, 0), Operator:=xlFilterCellColor
Range("d2", Range("d2").End(xlDown)).Select

Selection. Copy

1 Respuesta

Respuesta
2

Visita:

Cursos de Excel y Macros

----- --

[Ho la pep14 , te falta proporcionar información.

- Nombre de la hoja con datos.

- Nombre de la hoja destino.

- En dónde empiezan los datos

- Tienes encabezados

- En cuál fila se va a pegar

- Las siguientes copias se van a pegar abajo de la anterior

----- --

Pero veamos qué tan cerca estoy de solucionar tu pregunta:

- La siguiente macro supone que tus hojas se llaman Hoja1 y Hoja2. Que los datos empiezan en la fila 1, que tiene encabezados en la fila 1, que los colores a filtrar están en la columna D, que se van a pegar en la columna 1 empezando en la fila 1 y que las copias se van a ir pegando debajo de la anterior.

(Son muchas suposiciones, por eso comento que te falta información)

----- --

Prueba la siguiente macro y comenta.

Sub filtar_colores()
'Por Dante Amor
'
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim dic As Object
  Dim c As Range
  Dim lr As Long, lc As Long, lr2 As Long, k As Long, j As Long
  Dim ky As Variant
  '
  Application.ScreenUpdating = False
  '
  Set sh1 = Sheets("Hoja1")
  Set sh2 = Sheets("Hoja2")
  '
  If sh1.AutoFilterMode Then sh1.AutoFilterMode = False
  lr = sh1.Range("D" & Rows.Count).End(3).Row
  lc = sh1.Cells(1, Columns.Count).End(1).Column
  Set dic = CreateObject("scripting.dictionary")
  '
  For Each c In sh1.Range("D2:D" & lr)
    dic(c.Interior.Color) = Empty
  Next
  '
  sh2.Cells.Clear
  sh1.Rows(1).Copy sh2.Range("A1")
  j = 2
  For Each ky In dic.Keys
    With sh1.Range("A1", sh1.Cells(lr, lc))
      .AutoFilter 4, ky, xlFilterCellColor
      .Offset(1).Copy sh2.Range("A" & j)
      j = j + .Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
    End With
  Next
  sh1.ShowAllData
End Sub

----- --

Si algo le falta a la macro, entonces deberás proporcionar toda la información completa, un ejemplo de cómo tienes los datos y un ejemplo de cómo quieres el resultado.

----- --

Recomendaciones:

https://youtu.be/DI33KOtxcPk 

----- --

LO NUEVO:

https://www.youtube.com/watch?v=F_bZOUNVDiU&t=3s 
----- --

Sal u dos Dante Amor

----- --

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas