Pasar filas de color a hojas diferentes

monicasusi · el 12 de marzo

Saludos A todos:

Pues que tengo un problemita que no he podido resolver, si alguien me puede ayudar se agradecera de antemano

Paso a Explicar:

Tengo una hoja que se llama Datos que va de la Columna A a la Columna BI y en filas tiene casi 6000 en la Columna P se puede poner Pagada, Cancelada, Devolucion, Gestor o Juridico y en base a ella se pinta la fila, no con formato condicional sino con formato manual, he creado 5 hojas mas con los nombres Pagada, Cancelada, Devolucion, Gestor y Juridico, puedo seleccionar y copiar de manera manual una fila y pasarla a la hoja correspondiente, pero pense que con una macro seria mas rapido de hacer, ya que se haría de manera mensual pero no he podido dar con una idea de como, intente grabando el procedimiento manual pero siempre me copia la misma fila a la misma hoja

les dejo una copia del archivo para que se den una idea mas clara

Libro3 ejemplo.zip

tese1969 · el 12 de marzo

Buenas, monicasusi

A través de código (Macro) puedes hacerlo perfectamente e incluso no necesitarías tener en cuenta el color de la fila, salvo que lo necesites para otras referencias de tipo visual. Aún así, podrías "pintar" la fila también de manera automática, en base al tipo de "P" que tengas, a través de un código de evento (se ejecuta cuando sucede algo previamente definido), sin necesidad de hacerlo a mano.

Cuando cambies el valor de P ó lo incluyas por primera vez, se podría definir el color que debe tener la fila, sin necesidad de tener que ejecutar nada manualmente ó establecer un formato condicional.

Es importante saber si los datos querrías volcarlos una vez que los tienes todos incluidos mensualmente o te vendría mejor según los vas incluyendo que se fueran colocando en su respectiva Hoja/pestaña.

Una vez decidido esto, la estructura del código resulta más o menos sencilla de realizar.

Un saludo,

Tese

logroastur · el 12 de marzo

Buenas utiliza

Sub CopiaFiltro()
    Dim i As Long
    Dim x As Long
    Dim u As Long
    Dim d As Variant
    Dim t As Variant
    'DETENEMOS CONTROL DE ERRORES
    On Error Resume Next
    'DETENEMS EL CONTROL DE REFRESCO
    Application.ScreenUpdating = False
    'Valor de la columna P
    d = Array("Juridico", "Gestor", "Pagada", "Cancelada", "Devolucion")
    'VALOR DE LOS NOMBRES DE LAS HOJAS
    t = Array("Juridico", "Gestor", "Pagadas", "Canceladas", "Devoluciones")
    'ABRIMOS PROPIEDADES DE LA HOJA DATOS
    With Sheets("Datos")
        'TOMAMOS LA ÚLTIMA FILA USADA EN LA COLUMNA A
        u = .Range("A50000").End(xlUp).Row
        'VERIFICAMOS QUE POSEE DATOS
        If u &lt; 2 Then
            'SINO ES ASÍ SE LANZA ALERTA
            MsgBox "No existen datos a evaluar", vbExclamation, ""
            'Y SE ABORTA PROCESO
            Exit Sub
        End If
        'QUITAMOS EL POSIBLE FILTRO DE DATOS
        .ShowAllData
        'INICIAMOS BUCLE POR LOS DATOS DE LA COLUMNA p
        For i = LBound(d) To UBound(d)
            'ABRIMOS PROPIEDADES DE LOS DATOS DE LA HOJA DATOS
            With .Range("A1:BH" &amp; u)
                'APLICAMOS EL FILTO EN LA COLUMNA p
                .AutoFilter Field:=16, Criteria1:=d(i)
                'COPIAMOS EL RANGO DE DATS FILTRADOS
                .Copy
                'PEGAMOS EN LA CELDA DESTINO
                Sheets(t(i)).Range("A1").PasteSpecial
                'BORRAMOS AL MEMORIA DE PEGADO DE DATOS
                Application.CutCopyMode = False
                'QUITAMOS EL FILTO DE LA COLUMNA P
                .AutoFilter Field:=16
            End With
            'QUITAMOS EL POSIBLE FILTRO DE DATOS
            .ShowAllData
        Next i
        'QUITAMOS EL FILTRO DE DATOS
         .Range("A1:BH" &amp; u).AutoFilter
    End With
    MsgBox "Proceos finalizado", vbInformation, ""
End Sub

Un saludo

monicasusi · el 12 de marzo

Gracias Tese1969

y sobre todo gracias a logroastur que me funciono de maravilla, solo que se me olvido explicar dos detalles:

disculpas por haberlo olvidado

1.- Eliminar de la hoja Datos las filas que se han copiado a las hojas correspondientes, esto para no ir haciendo el archivo mas pesado de lo que esta

2.- Como el procedimiento es cada mes deberan irse acumulando en las hojas correspondientes al final de la ultima fila con datos de cada hoja

Espero no ser tan molesta por este olvido

bigpetroman · el 15 de marzo

Esta es una ligera modificación a la macro del amigo @[uSER=30966]logroastur[/uSER], te copia los datos al final de cada hoja y al finalizar, borra los datos de la hoja Datos

nota: puedes colocar el color de las filas con formato condicional, es más facil y no tienes que estar pintando nada manualmente

suerte

Sub CopiaFiltro()

    Dim i As Long

    Dim x As Long

    Dim u As Long

    Dim d As Variant

    Dim t As Variant


    Sheets("Datos").Select

    'DETENEMOS CONTROL DE ERRORES

    On Error Resume Next

    'DETENEMS EL CONTROL DE REFRESCO

    Application.ScreenUpdating = False

    'Valor de la columna P

    d = Array("Juridico", "Gestor", "Pagada", "Cancelada", "Devolucion")

    'VALOR DE LOS NOMBRES DE LAS HOJAS

    t = Array("Juridico", "Gestor", "Pagadas", "Canceladas", "Devoluciones")

    'ABRIMOS PROPIEDADES DE LA HOJA DATOS

    With Sheets("Datos")

        'TOMAMOS LA ÚLTIMA FILA USADA EN LA COLUMNA A

        u = .Range("A50000").End(xlUp).Row

        'VERIFICAMOS QUE POSEE DATOS

        If u < 2 Then

            'SINO ES ASÍ SE LANZA ALERTA

            MsgBox "No existen datos a evaluar", vbExclamation, ""

            'Y SE ABORTA PROCESO

            Exit Sub

        End If

        'QUITAMOS EL POSIBLE FILTRO DE DATOS

        .ShowAllData

        'INICIAMOS BUCLE POR LOS DATOS DE LA COLUMNA p

        For i = LBound(d) To UBound(d)

            'ABRIMOS PROPIEDADES DE LOS DATOS DE LA HOJA DATOS

            With .Range("A1:BH" & u)

                'APLICAMOS EL FILTO EN LA COLUMNA p

                .AutoFilter Field:=16, Criteria1:=d(i)

                'COPIAMOS EL RANGO DE DATS FILTRADOS

                .Range("A2:BH" & u + 1).Copy

                'PEGAMOS EN LA CELDA DESTINO

                Sheets(t(i)).Range("A" & Sheets(t(i)).Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial

                'BORRAMOS AL MEMORIA DE PEGADO DE DATOS

                Application.CutCopyMode = False

                'QUITAMOS EL FILTO DE LA COLUMNA P

                .AutoFilter Field:=16

            End With

            'QUITAMOS EL POSIBLE FILTRO DE DATOS

            .ShowAllData

        Next i

        'QUITAMOS EL FILTRO DE DATOS

        .Range("A1:BH" & u).AutoFilter

        'SE BORRAN TODOS LOS DATOS DE LA HOJA DATOS

        .Range("A2:BH" & u + 1).ClearContents

    End With

    MsgBox "Proceos finalizado", vbInformation, ""


End Sub[/CODE]

monicasusi · el 16 de marzo

Gracias bigpetroman la reviso mañana por la mañana y te comento y si, en cuanto a poner los colores lo hago con esta macro

Sub Colores()

' Color Macro

'

'por  Monicasusi

'Macro que colorea celda dependendiendo del valor que contenga esta

' en Rojo  3 si es Juridico,  Verde 4 si es Activa, Amarilla 6 si es Gestor

' Azul 8 si es Cancelada,  Verde obscuro si es Pagada y Rosa 22 si es Devolucion


ActiveSheet.Range("P2:P30000").Select

Dim Celda As Range


  For Each Celda In Selection

      If Celda.Value Like "Juridico" Then

          Celda.EntireRow.Interior.ColorIndex = 3



        ElseIf Celda.Value Like "Activa" Then

        Celda.EntireRow.Interior.ColorIndex = 4



        ElseIf Celda.Value Like "Gestor" Then

          Celda.EntireRow.Interior.ColorIndex = 6



        ElseIf Celda.Value Like "Cancelada" Then

          Celda.EntireRow.Interior.ColorIndex = 8


        ElseIf Celda.Value Like "Pagada" Then

          Celda.EntireRow.Interior.ColorIndex = 10


        ElseIf Celda.Value Like "Devolucion" Then

          Celda.EntireRow.Interior.ColorIndex = 22

      End If

  Next

Range("A1").Select


'

End Sub

[/CODE]

Antoni · el 16 de marzo

Si colocas esta macro en la hoja Datos, cada vez que cambies un valor en la columna P, se modificará el color de la fila de forma automática.

Private Sub Worksheet_Change(ByVal Target As Range)


Application.ScreenUpdating = False

Valor = Array("Juridico", "Gestor", "Pagada", "Cancelada", "Devolucion")

Kolor = Array(3, 4, 6, 8, 10)

For Each Celda In Target

  If Left(Celda.Address, 2) = "$P" Then

      Rows(Celda.Row).Interior.ColorIndex = xlNone

      For v = 0 To UBound(Valor)

        If UCase(Celda) = UCase(Valor(v)) Then

            Rows(Celda.Row).Interior.ColorIndex = Kolor(v)

            Exit For

        End If

      Next

  End If

Next


End Sub

[/CODE]

Antoni · el 16 de marzo

Hola:

No tengas en cuenta el post anterior, te adjunto una visión distinta del tema.

Cada vez que modifiques una celda de la columna P en la hoja Datos, aparte de actualizarse el color de la fila, se actualizarán todas las hojas de forma automática.

Saludos

Libro3 ejemplo MA.zip