Compara dos celdas si son iguales y copiar rango
Tengo dos hojas, en la hoja1, la celda A1=MESA1 entonces que me COMPARE con la Hoja2 si esta MESA1 en determinado rango de A2 a A6, si esta MESA1, entonces que me copie el rango de la hoja1 en A2 a A6 en la Hoja2 en b2:d2.
Que la macro me copie el rango, y me diga mesa1 copiada, mil gracias
1 Respuesta
Entra al Editor de macros (con Alt y F11). Inserta un módulo y allí copia lo siguiente:
Sub comparaMesas()
'x Elsamatilde
'se ejecuta desde la Hoja1
Hoja1.Select
dato = [A1]
'se busca en Hoja2 el contenido de A1
Set busco = Hoja2.[A:A].Find(dato, LookIn:=xlValues, lookat:=xlWhole)
'si encuentra el dato guarda en esa fila la info transpuesta
If Not busco Is Nothing Then
Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row).Copy
Hoja2.Select
Range("B" & busco.Row).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
'vuelve a Hoja1 y deja mensaje
Hoja1.Select
[A10] = "Mesa copiada"
Application.CutCopyMode = False
Else
MsgBox "No se encontró " & dato, , "INFORMACIÓN"
End If
End SubSdos y no olvides valorar la respuesta.
Como estoy buscando el fin de la lista desde abajo hacia arriba, el mensaje debiera estar en B10:
[B10] = "Mesa copiada"
De mantener el mensaje en A10, cambia la instrucción de copia:
Range("A3:A" & Range("A10").End(xlUp).Row).Copy
Sdos!
Muy bien Elsita, pero ahora necesito arreglar algo, que me vaya indicando y que me siga apareciendo una debajo de otra mesa1 grabada, mesa2 grabada, y si ya esta grabada pues me salga un mensaje mesa# grabada, anexo el archivo:
macro mesas :mendhozka
Muy bien Elsita, pero ahora necesito arreglar algo, que me vaya indicando y que me siga apareciendo una debajo de otra mesa1 grabada, mesa2 grabada, y si ya esta grabada pues me salga un mensaje mesa# grabada, anexo el archivo:
No hay nada en esos links que dejaste. Te paso la macro anterior modificada. El mensaje se muestra en col A.
Sub comparaMesas()
'x Elsamatilde
'se ejecuta desde la Hoja1
Hoja1.Select
dato = [A1]
'se busca en Hoja2 el contenido de A1
Set busco = Hoja2.[A:A].Find(dato, LookIn:=xlValues, lookat:=xlWhole)
'si encuentra el dato guarda en esa fila la info transpuesta
If Not busco Is Nothing Then
Range("A3:A" & Range("A10").End(xlUp).Row).Copy
Hoja2.Select
Range("B" & busco.Row).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
'vuelve a Hoja1 y deja mensaje
Hoja1.Select
Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = dato & " copiada."
'[A10] = "Mesa copiada"
Application.CutCopyMode = False
Else
MsgBox "No se encontró " & dato, , "INFORMACIÓN"
End If
End SubPor favor si necesitas seguir agregando o modificando detalles dejame una nueva consulta en el tablón luego de valorar ésta.
