Necesito una macro que me haga una lista

Necesito alistar algunos datos de un libro (agregando una hoja nueva que se llame Registros faltan tes en el mismo libro), estos datos están en distintas hojas, el parámetro es que si la celda A, B, E tienen datos y la Columna F no.

1.- Me copie esos datos y los pegue en la hoja llamada Registros faltantes

2.- Sí la hoja ocupa el máximo de filas ( me cree otra hoja llamada Registros faltan tes 2). Y así sucesivamente.

Gracias saludos, el libro se llama "Solicitud Grupos AD"

1 Respuesta

Respuesta
1

H o l a :

Pon la siguiente macro en tu libro "Solicitud Grupos AD"

Sub CopiarRegistrosFaltantes()
'Por.Dante Amor
'
    Application.ScreenUpdating = False
    'Determinar hoja de faltantes
    nmax = 0
    nhoja = "Registros Faltantes"
    existe = False
    For Each h In Sheets
        If InStr(1, h.Name, nhoja) > 0 Then
            num = Val(Mid(h.Name, Len(nhoja) + 2))
            If num > nmax Then
                nmax = num
            End If
            existe = True
        End If
    Next
    If existe Then
        Set h2 = Sheets(nhoja & " " & nmax)
    Else
        nmax = 1
        Set h2 = Sheets.Add(after:=Sheets(Sheets.Count))
        h2.Name = nhoja & " " & nmax
    End If
    '
    'copiar registros a la hoja faltantes
    For Each h In Sheets
        If InStr(1, h.Name, nhoja) = 0 Then
            u = h.Range("A" & Rows.Count).End(xlUp).Row
            h.Range("A1:F" & u).AutoFilter Field:=1, Criteria1:="<>"
            h.Range("A1:F" & u).AutoFilter Field:=2, Criteria1:="<>"
            h.Range("A1:F" & u).AutoFilter Field:=5, Criteria1:="<>"
            h.Range("A1:F" & u).AutoFilter Field:=6, Criteria1:="="
            u = h.Range("A" & Rows.Count).End(xlUp).Row
            If u > 1 Then
                cuenta = Application.CountA(h.Range("A2:A" & u).SpecialCells(xlCellTypeVisible))
                tot_filas = h.Range("A" & Rows.Count).Row
                u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
                disponible = tot_filas - u2
                If cuenta > disponible Then
                    Set h2 = Sheets.Add(after:=Sheets(Sheets.Count))
                    h2.Name = nhoja & " " & nmax + 1
                End If
                h.Rows("2:" & u).Copy
                u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
                h2.Range("A" & u2).PasteSpecial Paste:=xlValues
            End If
        End If
    Next
    MsgBox "Agregar registros a hoja Faltantes", vbInformation, "Proceso Terminado"
End Sub

'_

S a l u d o s . D a n t e   A m o r. Recuerda valorar la respuesta. G r a c i a s

‘_

Dice error 1004

Puedes poner el mensaje de error completo y en cuál línea de la macro se detiene.

¿Qué versión de excel tienes?

Tienes encabezados, ¿en qué fila tienes tus encabezados?

¿En qué fila empiezan tus datos?

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas