Copiar Celdas a otro libro con fechas
Para Dante Amor, necesito pasar datos a otro libro, tengo estos datos con fechas no consecutivas
A1 Fecha B1 Temp ....
01/01/1950 15
28/02/1950 12
1/02/1955 14
29/02/1955 16
y necesito algo así
A1Fecha (solo Día y mes) B1 1950 .....1955
01/01 15 14
02/01
03/01 14
28/02 12
29/02 16
Fechas consecutivas en la columna A y las celdas vacías las puedo dejar vacías, por los años bisiestos o faltantes y en las otras columnas solo el año y los datos
1 Respuesta
si, se puede? Es que si inserto una columna manualmente con los 366 días, se desplazan los datos por los años bisiestos
Necesito algo así:
1950 1951 1952 .....
1/1 15 ..... ........
.....
31/12 28 30 31
Cuando falta un día deja el espacio en blanco. Lo que hago es primero detectar cuales son los días que faltan e inserto una celda.
Desde muchas gracias!
Así me debe quedar
Envíame tu archivo con 2 hojas. Para ver cómo tienes la información y cómo la quieres.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “Alejandra Fernández”
Te anexo la macro
Sub procesar()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.StatusBar = False
Set l1 = ThisWorkbook
Set h1 = l1.ActiveSheet
libro = h1.[M1]
hoja = h1.[M2]
col = h1.[M3]
'
If libro = "" Then
MsgBox "Captura el libro destino"
Exit Sub
End If
If hoja = "" Then
MsgBox "Captura la hoja destino"
Exit Sub
End If
If col = "" Then
MsgBox "Captura la columna origen"
Exit Sub
End If
existe = False
For Each h In Workbooks
If LCase(h.Name) = LCase(libro) Then
existe = True
Exit For
End If
Next
If existe = False Then
MsgBox "No está abierto el libro: " & libro2
Exit Sub
End If
'
existe = False
Set l2 = Workbooks(libro)
For Each h In l2.Sheets
If LCase(h.Name) = LCase(hoja) Then
existe = True
Exit For
End If
Next
If existe = False Then
MsgBox "La hoja destino no existe en el libro destino"
Exit Sub
End If
Set h2 = l2.Sheets(hoja)
'
u = h1.Range("A" & Rows.Count).End(xlUp).Row
For i = 4 To u
Application.StatusBar = "Procesando registro : " & i & " de : " & u
dia = Day(h1.Cells(i, "A"))
mes = Month(h1.Cells(i, "A"))
año = Year(h1.Cells(i, "A"))
fecha = DateSerial(2016, mes, dia)
Set b = h2.Columns("A").Find(fecha, lookat:=xlWhole)
If Not b Is Nothing Then
fila = b.Row
Set b = h2.Rows(1).Find("a" & año, lookat:=xlWhole)
If Not b Is Nothing Then
cold = b.Column
h2.Cells(fila, cold) = h1.Cells(i, col)
End If
End If
Next
Application.StatusBar = False
MsgBox "Fin"
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
