Para DAM una macro que me traslade los datos de una hoja a otra pero con pegado especial valores y trasponer
Hola DAM
Mi inquietud es la siguiente. En la hoja INGRESAR DATOS ingreso datos desde la celda D200 a la celda D211 (Verticalmente) y quisiera una macro que tome esos datos y los vaya recopilando en la hoja BASE desde la fila 2 en adelante dado a que la fila 1 tengo los nombres de cada columna de datos.
Para mayor explicación, el dato D200 lo necesito en la columna A, el D201 en la Columna B, el D202 en la columna C, el D203 en la columna DE, el D204 en la columna E y aquí viene lo interesante, en la columna F necesito colocar la fórmula de la edad pues en la columna anterior es decir en la columna E he puesto la fecha de nacimiento de la persona.
Después de esto sigo con el dato D205 en la columna G, D206 en la columna H y así sucesivamente hasta terminar con el dato D211 en la columna M.
La idea es que cada vez que yo ejecute la macro me vaya guardando los datos que he ingresado en la hoja INGRESAR DATOS en la hoja BASE, de esta forma armándome una BASE DE DATOS.
Agradezco su colaboración
1 Respuesta
Te anexo la macro
Sub IngresarDatos()
'Por.Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("ingresar datos")
Set h2 = Sheets("base")
Dim f As Date
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
h1.Range("D200:D203").Copy
h2.Range("A" & u2).PasteSpecial Paste:=xlPasteValues, Transpose:=True
h1.Range("D204").Copy h2.Range("E" & u2)
h2.Range("F" & u2) = Edad(h2.Range("E" & u2), Date)
h1.Range("D205:D211").Copy
h2.Range("G" & u2).PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
MsgBox "Datos ingresados", vbInformation, "Fecha: " & Date
End Sub
Function Edad(fecha1 As Date, fecha2 As Date) As String
'http://lqrexceltotal.blogspot.mx/2009/03/la-funcion-sifecha.html
Temp1 = DateSerial(Year(fecha2), Month(fecha1), Day(fecha1))
Y = Year(fecha2) - Year(fecha1) + (Temp1 > fecha2)
M = Month(fecha2) - Month(fecha1) - (12 * (Temp1 > fecha2))
D = Day(fecha2) - Day(fecha1)
If D < 0 Then
M = M - 1
D = Day(DateSerial(Year(fecha2), Month(fecha2) + 1, 0)) + D + 1
End If
Edad = Y & " años " & M & IIf(M = 1, " mes ", " meses ") & D & IIf(D = 1, " día ", " días")
End FunctionPon la macro IngresarDatos en un botón, la otra es una función para calcular la edad.
Saludos. Dante Amor
Recuerda valorar la respuesta.
