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
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 SubAl 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!!!
