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

Respuesta
2
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 if

Bueno 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 Sub

esta 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 Sub

para que siempre use de referencia el valor en "E1" de la hoja 2 como fila de inicio

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas