Macros para pegar datos acorde a la fecha
Para dante amor: hola dante. El motivo de esta consulta es continuar con la pregunta anterior. Hay una macros que me pasate que me ayuda a copiar un rabgo de datos de la hoja 1 y lo pega en la hoja 2 teniendo en cuenta el mes. Pero cuando llega a diciembre vuelve a ubicarse en la primera columna la macros.
Necesito por favor que la macros pegue datos encima de otros datos sin importar la fecha y cambiando a la siguiente columna o que pegue los datos en la hoja 2 teniendo en cuenta el mes y el año.
1 Respuesta
Dante, buenas noches:
Adjunto imagen. Como podrás ver en las filas superiores especifico el año y el mes. El problema es que con la macro anterior cuando llego a diciembre vuelve a ubicar los datos copiados a partir de la hoja 1 en la primera columna a la derecha, en este caso Agosto.
Resulta que yo no comienzo a alimentar esta base de datos en Enero, sino en Agosto de 2014 hasta la fecha y por eso, quisiera que la macros se alimentara columna a columna pero teniendo en cuenta el mes y el año.
Adicionalmente la importancia de que pegue datos encima de celdas que ya contienen "algo" es porque los datos de la última columna van a ser los datos que me sirven para una proyección. Es decir que por ejemplo la celda D7, antes de contener datos, era =C7.
Espero que esta imagen sea de ayuda y agradezco nuevamente tu amable colaboración.
H o l a:
Te anexo la macro actualizada, seguimos con el hecho de que vas a poner en la hoja1, enl a celda B1 una fecha, de ahí se tomará el año y el mes.
Sub Copia4()
'Act.Por.Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
'
año = Year(h1.[B1])
mes = Format(h1.[B1], "mmmm")
col = ""
For i = 2 To h2.Cells(1, Columns.Count).End(xlToLeft).Column
If h2.Cells(1, i) = año And UCase(h2.Cells(2, i)) = UCase(mes) Then
col = i
Exit For
End If
Next
If col = "" Then
MsgBox "No existe el año y mes", vbCritical, "ERROR DE FECHA"
Exit Sub
End If
h1.Range("B2:B5").Copy
H2. Cells(13, col). PasteSpecial xlPasteFormats
h2. Cells(13, col). PasteSpecial xlPasteValues
Application.CutCopyMode = 0
Application.ScreenUpdating = False
MsgBox "Celdas copiadas", vbInformation
End Sub[code]:)
S aludos. D ante A mor. R ecuerda valorar la respuesta.
