Macro para que al colocar una palabra copie los resultado a otra hoja
Dante y sebastian nuevamente buscando sus conocimientos y apoyo.
Quiero hacer lo siguiente tengo un formato en excel que dos hojas o libros en uno de ellos ingreso los siguientes datos fecha, nombre, referencia, numero y monto lo que quiero que si coloco la palabra anulado en la columna de regencia automáticamente me traslade para la otra hoja los datos que seria nombre, numero y monto de esa fila que en la otra hoja coloque anulado, y cada vez que vaya colocando anulado, traslade la información para la otra hoja pero los datos los debe ir colocando en la siguiente fila y así sucesivamente
Si es necesario subo imágenes para darme a entender mas
1 Respuesta
Dim Celda as Range
Ser h1 = sheets("hoja1")
Ser h2 = sheets("hoja2")
Set Celda = Activecell
Nombre = range("A1")
Número = range("B1")
Monto = range ("C1")
Ufila = H2.range("A" & rows.Count).End(xlup).row + 1
If target.column = 5 then
If Celda.value = "Anulado" then
H1. Nombre. Copy
H2. Cells(ufila, 1). Pastespecial xlvalues
H1. Número. Copy
H2. Cells(ufila, 2). Pastespecial xlvalues
H1. Monto. Copy
H2. Cells(ufila, 3). Pastespecial xlvalues
H2.cells(ufila,4).value = "Anulado"
End ifBueno haber, de entrada te aclaro que estoy escribiendo a ojo desde mi del y sin tener donde hacer pruebas jeje (un tiro al aire ) está macro hiria en la hoja pero pruebala en una copia del archivo o un libro de prueba
Tiene rangos ficticios pero prueba si funciona y después ajustados los rangos
Funciona sobre la columna 5(E) si escribes "Anulado"
Copiarlos A1 B1 C1 y los pegaría debajo de la última fila con datos de la hoja 2 columnas A B C y en la D pondría "Anulado"
Chequa si funciona y me dices
Nombre de las hojas : hoja1(origen) hoja2(destino)
Faltan agregarle el
Sub
End sub
¡Gracias!
A donde se agregaría debido a, que me da error la macro
Disculpa donde va el sub y end sub debido a que me da erro te adjunto pantalla, también tengo dudas con esto a que te referís con Copiarlos A1 B1 C1 y los pegaría debajo de la última fila con datos de la hoja 2 columnas A B C y en la DE pondría "Anulado"
Por eso te dije que no la había probado y estaba escrita a ojo
Pero como era de saber por la hora (sueño) + sin probarla
Estaba llena de errores je je
Pega esta macro en un modulo
Sub CopiarValores()
Set H1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
Dim Xcel As Object
Dim Rng As Range
Set Rng = H1.Range("C1:C100")
criterio = "anulado"
For Each Xcel In Rng
If Xcel.Value = criterio Or Xcel.Value = UCase(criterio) Then
uf2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
h2.Cells(uf2, 1) = Xcel.Offset(0, -1)
h2.Cells(uf2, 2) = Xcel.Offset(0, 1)
h2.Cells(uf2, 3) = Xcel.Offset(0, 2)
h2.Cells(uf2, 4) = Xcel
End If
Next Xcel
End Subesta si la hice y la probe xD je je recuerda cambiar el rango (C1:C100) por el tuyo
Si te sirvió la información no olvides valorar la respuesta =)
Esa macro la hice con este ejemplo
Como hago para su se ejecute la macro sebastián
Tienes diferentes maneras de ejecutar una macro(no es automática)
- Pon botón en la hoja
- Pon una cinta personalizada y agrega ahí tu macro
- Pon la macro en la barra de botones rápidos
O simplemente presiona ALT +F8 y Selecciona tu macro y haz click en ejecutar
Como ves tienes varias formas
O quizás puedas poner en el módulo de la hoja que si estás sobre una columna POR se ejecute la macro, por ejemplo la columna 3 como en el ejemplo( no se si funcionara)
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If target.column = 3 then Call CopiarValores End if End Sub
Ya probé la macro Sebastian pero cada vez que ejecuto la macro vuelve a copiar los valores que ya había copiado anteriormente
Lo podrías hacer así
Sub CopiarValores()
Set H1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
Dim Xcel As Object
Dim Rng As Range
Dim ncolum, ifila, ucolum, ufila As Integer
Dim rangoconteo As String
On Error Resume Next
If h2.Cells(1, 5).Value = "" Then
h2.Cells(1, 5).Value = 1
End If
ifila = h2.Cells(1, 5)
ncolum = 3
ufila = 100
rangoconteo = Range(Cells(ifila, ncolum), Cells(ufila, ncolum)).Address
criterio = "anulado"
For Each Xcel In Range(rangoconteo)
If Xcel.Value = criterio Or Xcel.Value = UCase(criterio) Then
uf2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
h2.Cells(uf2, 1) = Xcel.Offset(0, -1)
h2.Cells(uf2, 2) = Xcel.Offset(0, 1)
h2.Cells(uf2, 3) = Xcel.Offset(0, 2)
h2.Cells(uf2, 4) = Xcel
End If
Next Xcel
h2.Cells(1, 5).Value = H1.Range("A" & Rows.Count).End(xlUp).Row
End Subpara que siempre use de referencia el valor en "E1" de la hoja 2 como fila de inicio
