Definir variable que busque un parámetro (fecha) y lo copie en otra hoja. A través de una macro. Excel 2007

Tengo dos macros,

1) te busca el texto que coincide con el patron "**/**/***" en este caso una fecha

Sub BUSCAR_TEXTO()

Dim Celda As Range

Dim PALABRA As String

PALABRA = "*" & "**/**/***" & "*"
For Each Celda In Range("A1:K1")
If Celda.Value Like PALABRA Then
Celda.Interior.ColorIndex = 49
End If
Next Celda
End Sub

2)Copia el contenido de la celda e1 de la hoja datos a la celda e1 de la hoja resumen

Sheets("DATOS").Select
Range ("E1").Select
Selection.Copy
Sheets("RESUMEN").Activate
Range("E1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Lo que quiero es "fusionarlas" para que la celda de origen de la macro 2 (E1) sea la variable "PALABRA" de la macro 1. Lo hago de la siguiente manera pero no me funciona...

Sub COPIAR2()

Dim PALABRA As String

PALABRA = "*" & "**/**/***" & "*"
For Each Celda In Range("A1:K1")
If Celda.Value Like PALABRA Then
Celda.Interior.ColorIndex = 49
End If
Next Celda

Sheets("DATOS").Select
Range("PALABRA").Select
Selection.Copy
Sheets("RESUMEN").Activate
Range("E1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub

Estaría enormemente agradecido a quién me pueda ayudar.

1 respuesta

Respuesta
1

Puedes utilizar esto:

Sub BUSCAR_TEXTO()
Dim Celda As Range
Dim PALABRA As String
PALABRA = "*" & "??/??/????" & "*"
For Each Celda In Range("A1:K1")
    If Celda.Value Like PALABRA Then
        Celda.Interior.ColorIndex = 49
        Celda.Select
        VVV = Celda.Address
        Celda.Copy
        Worksheets("RESUMEN").Range(VVV).PasteSpecial xlPasteAll
    End If
Next Celda
End Sub

Nota dos cosas:

¿En primer lugar he sustituido los * por? Cuando defines la variable palabra. De este modo te aseguras de no tomar como fecha algo como por ejemplo esto: "sddv/sdusadvi/asdsadfad", puesto que limitas quetu partrón DEBE contener un número de caracteres determinado.

En segundo lugar, lo que estoy haciendo es recorrer las celdas del rango indicado (a1:k1) y las que coinciden con el patrón las pinto y las copio y pego en la hoja resumen, en la misma posición en la que están en la hoja actual, caso de necesitar que te las liste de algún modo se debería adaptar el código.

¡Muchísimas Gracias!

Es exactamente lo que buscaba. Creo que no será la última pregunta que haga... ya lo siento, pero es que tengo que hacer un proyecto faraonico dado mi nivel de excel. 

Poco a poco, entre lo que vayas aprendiendo y lo que te solucionemos por aquí seguro que lo sacas.

¡Muchas Gracias! 

Buenas tardes Víctor!! Tengo unas pequeñas dudas con este código. Lo que me pasa es que me llega un correo todos días y viene con la fecha de ese día, entonces quiero que busque la fecha (que ahora lo hace perfecto) y me la vaya poniendo cada día en una celda (las celdas serían siempre B3,C3,D3,E3 y F3 los 5 días de la semana, de la hoja RESUMEN) ¿Cómo podría hacerlo? Esque intento cambiar la celda de destino pero no se muy bien como...  Y me sale error! Muchas gracias de antemano crack!!!

Ok, esto ya es más complicado. La solución pasa por identificar la fecha concreta, qué día de la semana es y pegar donde corresponda, pero según tu enunciado entiendo que en los datos que aparecen en el rango A1:K1 puede haber texto, la fecha y más texto. Entonces hay que "extraer" de alguna manera la fecha de la posible cadena de texto, luego determinar qué día de la semana es y luego pegar donde corresponda.

Algo así:

Sub BUSCAR_TEXTO()
Dim Celda As Range
Dim PALABRA As String
Dim VR As Range
PALABRA = "*" & "??/??/????" & "*"
For Each Celda In Range("A1:K1")
    If Celda.Value Like PALABRA Then
        Celda.Interior.ColorIndex = 49
        Celda.Select
        'VVV = Celda.Address
        Celda.Copy
        'Worksheets("RESUMEN").Range(VVV).PasteSpecial xlPasteAll
        vals = InStr(1, Celda.Value, "/")
        vfech = Mid(Celda.Value, vals - 2, 10)
        vfech = CDate(vfech)
        vdia = Weekday(vfech, 2)
       'VR = Cells(3, vdia + 1)
        Worksheets("RESUMEN").Cells(3, vdia + 1).PasteSpecial xlPasteAll
    End If
Next Celda
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas