Insertar celda nueva con datos nuevos
Mi primer pregunta, si tiene un error por favor decirme y corrijo.
Tengo un par de hojas en un libro excel, en una hoja copio una cantidad de datos específicos para pegar a otra hoja, en esta segunda hoja agrego datos a los anteriores copiados en sus filas susedaneas. El problema que tengo es que al agregar datos en la primera hoja, cuando actualizo la segunda los datos vienen correctamente, pero las celdas que agregue en esta hoja se desfasan, quiero contrarrestar esto. No se si es claro, cuesta explicarlo. Mi macro es este
Sub Actualizar()
'
' Actualizar Macro
'
'
Application.ScreenUpdating = False
Sheets("Cronograma ajustado").Select
Range("B4").Select
Selection.AutoFilter
ActiveSheet.Range("$A$4:$AF$500").AutoFilter Field:=7, Criteria1:=Array( _
"7302 FD", "7302 XD", "MA5600"), Operator:=xlFilterValues
ActiveSheet.Range("$A$4:$AF$500").AutoFilter Field:=20, Criteria1:=Array( _
"02-Desinstalado Parcial", "03-Retiro Pendiente", "04-Desconectado", _
"05-Desconectado Parcial", "06-Apagado", "08-En Proceso Baja de Rangos", _
"09-Solicitud de Baja"), Operator:=xlFilterValues
Range("B70:B503,G70:H503").Select
Range("G503").Activate
ActiveWindow.SmallScroll ToRight:=3
Range("B70:B503,G70:H503,T70:T503").Select
Range("T70").Activate
Selection.Copy
ActiveWindow.SmallScroll Down:=-21
Sheets("Recursos para Reutilizar").Select
Range("A2:D1150").Select
ActiveSheet.Paste
Range("A1").Select
Sheets("Cronograma ajustado").Select
Application.CutCopyMode = False
Selection.AutoFilter
Range("B4").Select
Sheets("Recursos para Reutilizar").Select
Range("A1").Select
Application.ScreenUpdating = False
End SubQuiero que en la Hoja recursos a utilizar cuando lleguen estos datos de la otra hoja me quede un espacio en blanco para los datos nuevos que venga desde Cronograma Ajustado.
1 Respuesta
H o l a:
Si entendí bien, lo que quieres, ¿qué el siguiente pegado se realice después de una fila en blanco?
Si es así, prueba con la siguiente macro:
Sub Actualizar()
'Act.Por.Dante Amor
'Actualizar Macro
Application.ScreenUpdating = False
Set h1 = Sheets("Cronograma ajustado")
Set h2 = Sheets("Recursos para Reutilizar")
h1.Range("B4").AutoFilter
h1.Range("A4:AF500").AutoFilter Field:=7, _
Criteria1:=Array("7302 FD", "7302 XD", "MA5600"), Operator:=xlFilterValues
h1.Range("A4:AF500").AutoFilter Field:=20, Criteria1:=Array( _
"02-Desinstalado Parcial", "03-Retiro Pendiente", "04-Desconectado", _
"05-Desconectado Parcial", "06-Apagado", "08-En Proceso Baja de Rangos", _
"09-Solicitud de Baja"), Operator:=xlFilterValues
u = h2.Range("D" & Rows.Count).End(xlUp).Row + 2
h1.Range("B70:B503,G70:H503,T70:T503").Copy h2.Range("A" & u)
h1.Range("B4").AutoFilter
Application.ScreenUpdating = False
MsgBox "Fin"
End Sub':) 'S aludos. D a n t e A m o r . R ecuerda valorar la respuesta. G racias ':)
en realidad solo los sitios que se repitan, hay una fila nombre de sitios en Cronograma ajustado que se pega en Recursos a reutilizar, lo que yo necesito es que cuando el macro intente pegar me pegue los sitios que están repetidos pero tienen otro nodo distinto abajo (los nodos osn 7300 fd, xd etc).
Ejemplo
Hoja Uno tiene
Salto 7302 FD
Tacuarembo 7302XD
estos se pegan en la hoja 2
Luego en la hoja uno agrego
Salto 7302 FD
Salto 7302 XD
Tacuarmebo 7302XD
Quiero que el Salto repetido quede abajo de todos los demás que ya fueron pegados la anterior ves que corri el script y asi susesibamente. Agrego
Salto 7302 FD
Salto 7302 XD
Tacuarembo MA5600
Tacuarembo 7302XD
Quiero que este tacuarembo nuevo quede a lo ultimo de la hoja.
No se si me explico es engorroso.
Gracias por la respuesta
Puedes enviarme tu archivo y me explicas con ejemplos y con colores lo que deseas.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “Juan Manuel Vignolo Pedroncino” y el título de esta pregunta.
Te anexo la nueva macro para copiar registros.
Sub CopiarNuevos()
'Por.Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("Cronograma Ajustado")
Set h2 = Sheets("Recursos para Reutilizar")
'
u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
h1.Range("A1").AutoFilter
h1.Range("A1:S" & u1).AutoFilter Field:=6, _
Criteria1:=Array("7302 FD", "7302 XD", "MA5600"), Operator:=xlFilterValues
h1.Range("A1:S" & u1).AutoFilter Field:=19, _
Criteria1:=Array( _
"02-Desinstalado Parcial", "03-Retiro Pendiente", "04-Desconectado", _
"05-Desconectado Parcial", "06-Apagado", "08-En Proceso Baja de Rangos", _
"09-Solicitud de Baja"), Operator:=xlFilterValues
n = 0
For i = 2 To u1
If h1.Rows(i).Hidden = False Then
existe = False
Set r = h2.Columns("A")
Set b = r.Find(h1.Cells(i, "A"), lookat:=xlWhole)
If Not b Is Nothing Then
ncell = b.Address
Do
If h2.Cells(b.Row, "B") = h1.Cells(i, "F") And _
h2.Cells(b.Row, "C") = h1.Cells(i, "G") Then
existe = True
Exit Do
End If
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> ncell
End If
If existe = False Then
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
h2.Cells(u2, "A") = h1.Cells(i, "A")
h2.Cells(u2, "B") = h1.Cells(i, "F")
h2.Cells(u2, "C") = h1.Cells(i, "G")
h2.Cells(u2, "D") = h1.Cells(i, "S")
n = n + 1
End If
End If
Next
If h1.AutoFilterMode Then h1.AutoFilterMode = False
Application.ScreenUpdating = True
MsgBox "Registros nuevos copiados: " & n, vbInformation, "COPIAR NUEVOS"
End SubS aludos.D ante A mor. R ecuerda cambiar la valoración a la respuesta.
