Buscar, copiar y pegar con macros
Tengo el siguiente caso en un archivo de excel como pueden ver en la siguiente imagene
En la columna A tengo en ciertas filas sin orden especifico la palabra "Valor" seguido de esta hay unos valores que pertenecen exactamente a fila de arriba y se deben copiar o cortar y pegar en la fila de arriba a partir de la columna D, igual en algunas filas la información si me aparece correctamente
Como puedo hacer una macro para que busque la palabra "Valor" en la columna A, que en la fila donde las encuentre copie los valores que ahí se encuentren y los copie en la fila de arriba a partir de una columna definida, ¿posteriormente elimine la fila donde esta la palabra "Valor"?
De haberte entendido
Sub traslado_y_elimino()
Range("a65000").End(xlUp).Offset(1, 0).Value = "end"
Range("A1").Select
Do While ActiveCell.Value <> "end"
If ActiveCell.Value = "valor" Then
Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 1).End(xlToRight)).Copy
ActiveCell.Offset(-1, 0).End(xlToRight).Offset(0, 1).Select
ActiveCell.PasteSpecial xlPasteValues
ActiveCell.Offset(1, 0).End(xlToLeft).Select
ActiveCell.EntireRow.Delete
ActiveCell.Offset(1, 0).Select
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
End SubEn caso de que sea lo que necesitas agradecere valores mi trabajo
Hola gracias por tu respuesta, he intentado ejecutar la macro pero el libro se me queda pegado buscando creo que la palabra "Valor" cuando esta solo se encuentra en la columna A
Tal vez para que sea mas claro lo que yo quiero después de buscar la palabra "valor" en la columna A cada que la encuentre, por ejemplo en la imagen que adjunte en la consulta sale por primera vez en la fila 2, yo quiero que la macro agarre los valores de B2:D2 y los copie y los pegue en las celdas D1:F1, en el segundo caso la palabra "valor" sale en la fila 4, ahi quiero que copie los valores de las celdas B4:D4 y los pegue en las celdas D3:F3 así sucesivamente, posteriormente elimine la fila donde esta la palabra "valor"
mandame tu archivo a [email protected]
Eso es justamente lo que hace la macro que te envíe, pero mándame tu archivo al correo que te mencioné para revisarlo
2 respuestas más de otros expertos
. :)
Hola! Esteban. Por ejemplo así:
Sub traslado_y_elimino()
Dim C As Range
Set C = Columns("a").Find("valor", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False)
Do Until C Is Nothing
With C
C.Offset(, 1).Resize(, .CurrentRegion.Columns.Count - 1).Cut Cells(.Row - 1, "q")
C.ClearContents
End With
Set C = Columns("a").FindNext
Loop
End Sub
Hola gracias por tu respuesta, muy cerca en realidad
Tengo un par de dudas solamente, lo que yo deseo exactamente es esto que busque la palabra "valor" en la columna A y cada que la encuentre, por ejemplo en la imagen que adjunte en la consulta sale por primera vez en la fila 2, yo quiero que la macro agarre los valores de B2:D2 y los copie y los pegue en las celdas D1:F1, en el segundo caso la palabra "valor" sale en la fila 4, ahi quiero que copie los valores de las celdas B4:D4 y los pegue en las celdas D3:F3 así sucesivamente, posteriormente elimine la fila donde esta la palabra "valor"
En la macro que me enviaste si realiza eso, los valores los pega en la fila anterior pero en la columna Q no se porque y también lo que hace la macro es borrar los valores de las filas donde estaba la palabra "Valor" y yo necesito que elimine esta fila totalmente, se puede?
Disculpa, ya logre adaptar tu grandiosa macro a lo que quería, únicamente lo que se no se como hacer es eliminar la fila donde estaba la palabra "Valor" ya que con la macro que me enviaste lo que hace es borrar el contenido
.
Un "pequeño" retoque, entonces:
Sub traslado_y_elimino()
Dim C As Range
Set C = Columns("a").Find("valor", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False)
Do Until C Is Nothing
With C
C. Offset(, 1). Resize(, .CurrentRegion.Columns.Count - 1). Cut Cells(.Row - 1, "ba").End(xlToLeft). Offset(, 1)
C.EntireRow.Delete
End With
Set C = Columns("a").FindNext
Loop
End Sub¿Ahora sí?...
.
.
Prueba con esta macro y comentas
Sub copiar()
Set datos = Range("a1").CurrentRegion
With datos
.Sort key1:=Range(.Columns(1).Address), order1:=xlAscending
cuenta = WorksheetFunction.CountIf(.Columns(1), "valor")
fila = WorksheetFunction.Match("valor", .Columns(1), 0)
Set origen = .Rows(fila).Resize(cuenta)
Set destino = .Columns(.Columns.Count + 1).Resize(cuenta, .Columns.Count)
With origen
destino.Value = origen.Value
.ClearContents
End With
End With
End Sub