Necesito mejorar esta macro, que cumpla estas 2 condiciones

Este código, lo que me estaría faltando son 2 cosas:

1.- Cuando copie la fila completa a la hoja "Auxiliar SCT" lo haga en la sgte fila vacia que encuentre... Pero desde la sgte vacia, desde la fila A6 hacia abajo, (ya que como hay títulos, los está copiando debajo del titulo). En la fila A6 hacia abajo se deberian copiar los datos que cumplan con el requisito.

2.- Que omita el copiado de la columna AG (de la hoja "Auxiliar Provisorio", columna que contiene la frase "SI"), al pegar en la hoja "Auxiliar SCT". Este es el código que tengo:

Sub Copiar_SI()

Set h1 = Sheets("Auxiliar Provisorio")

Set h2 = Sheets(" Auxiliar SCT")

    Application.ScreenUpdating = False

    For i = 2 To h1.Range("AG" & Rows.Count).End(xlUp).Row

        If h1.Cells(i, "P") = "SI" Then

            u = h2.Range("P" & Rows.Count).End(xlUp).Row + 1

            h1.Rows(i).Copy

            h2.Range("A" & u).PasteSpecial xlValues

         End If

    Next i

    '

    Application.CutCopyMode = False

    Application.ScreenUpdating = True

        For i = 2 To h1.Range("AG" & Rows.Count).End(xlUp).Row

        If h1.Cells(i, "AG").Value = "SI" And h1.Cells(i, "AI").Value = "" Then

            u2 = h2.Range("AG" & Rows.Count).End(xlUp).Row + 1

            h1.Rows(i).Copy h2.Rows(u2)

            h1.Cells(i, "AI").Value = "copiado"

        End If

    Next

    MsgBox "Registros copiados", vbInformation, "FIN"

End Sub

1 respuesta

Respuesta
1

Te anexo la macro actualizada

Solamente revisa lo siguiente.

En esta línea de la macro

u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1

La columna "A" significa que siempre va a tener datos, si la columna "A" no siempre tiene datos, entonces cambia la letra "A" por una letra de columna donde siempre existan datos, por ejemplo, si la columna "B" siempre tiene datos, entonces en la macro la línea quedaría así:

u2 = h2.Range("B" & Rows.Count).End(xlUp).Row + 1


Avísame si necesitas más cambios a la macro y con gusto lo hago.

Sub Copiar_Fila()
'Por Dante Amor
    Application.ScreenUpdating = False
    Set h1 = Sheets("Auxiliar Provisorio")
    Set h2 = Sheets("Auxiliar SCT 2")
    '
    For i = 2 To h1.Range("AG" & Rows.Count).End(xlUp).Row
        If h1.Cells(i, "AG").Value = "SI" And h1.Cells(i, "AI").Value = "" Then
            u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
            If u2 < 6 Then u2 = 6
            h1.Range("A" & i & ":V" & i).Copy
            h2.Rows(u2).PasteSpecial xlValues
            h1.Cells(i, "AI").Value = "copiado"
        End If
    Next
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "Registros copiados", vbInformation, "FIN"
End Sub

Al final de mi respuesta hay un botón para valorar: "Voto" y "Excelente", si la macro funciona apreciaría que valoraras mi respuesta.

¡Gracias!  Dante, realmente fuiste un amor! Muchísimas Gracias por tu ayuda y tiempo. 

Funciono Súper bien!!! 

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas