Macro que copie datos si cumple la condición "si"en otra hoja, pero pegue los datos desde A6 hacia abajo en la sgte fila vacia

Necesito mejorar o modificar esta macro, que cumpla estas 2 condiciones:

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

1.- Cuando pegue el copiado de los datos como valores a "Auxiliar SCT" lo haga en la sgte fila vacia que encuentre, desde la fila A6 hacia abajo, (ya que entre títulos hay filas vacias). En la fila A6 hacia abajo se deberían copiar los datos que cumplan con el requisito.

2.- Que solo copie desde la columna A hasta la V de la hoja "Auxiliar Provisorio" y los copie en "Auxiliar SCT" (hasta el momento copia la fila completa).

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

Modifica tu código de esta manera:

(La segunda parte no se si te interesa o debes suprimirla, o si no modificarla igual que esta)

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
If u < 6 Then u = 6 '**** Aqui limitas que la 1 linea sea la fila 6
'***Cambia esta linea, en vez de h1.rows(i).copy pon este rango
h1.Range(Cells(i, "A").Address, Cells(i, "V").Address).Copy
h2.Range("A" & u).PasteSpecial xlValues
End If
Next i
End Sub

¡Suerte!

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas