Como puedo copiar y pegar cierta cantidad de registros de un libro a otro y a su vez poner la fecha.

hola :

Estoy realizando una macros que selecciona registros los copia y pega en un nuevo libro,pero asu vez cuando los pega tiene que ponerle la fecha y hora del sistema (solo a los datos pegados).

estoy usando este código:

Sub insertahistorial()
Dim MiFecha
MiFecha = Date

Application.Goto Reference:="R1C1"
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Workbooks.Open Filename:="D:\DATA\HISTORICO.xlsx"
Application.Goto Reference:="R1C1"
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Application.Goto Reference:="R1C1"
Application.CutCopyMode = False
ActiveWorkbook.Save
' ActiveWindow.Close
Application.Goto Reference:="R1C1"
Selection.End(xlDown).Select
Selection.End(xlToRight).Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = MiFecha
ActiveCell.Select
Selection.Copy
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Application.Goto Reference:="R1C1"
ActiveWorkbook.Save
ActiveWindow.Close

End Sub

Funciona bien pero al momento de poner la fecha a los registros pegados pega un registro de mas y elimina la fecha anterior.Elemplo si pegue 5 registros le pne la fecha a 6 registros.

Espero me puedan ayudar

gracias

1 Respuesta

Respuesta
1

Te mando un ejemplo construido por mi un poco más corto:

Esta macro estará en el libro principal, al ejecutarla abrirá un libro llamado ejemplo en el que vamos a copiar el rango A1:¿A? De la hoja1 del libro principal a la hoja datos del libro ejemplo a partir del rango A13. También pondremos en la celda contigua de los datos copiados la fecha y la hora del suceso. Para terminar el libro ejemplo.xlsx queda guardado y cerrado.

Sub ejemplo()
'por luismondelo
mio = ActiveWorkbook.Name
Workbooks.Open "C:\Users\Luis\Downloads\ejemplo.xlsx"
otro = ActiveWorkbook.Name
Workbooks(mio).Activate
Sheets("hoja1").Select
Range("a1:a" & Range("a65000").End(xlUp).Row).Copy
Workbooks(otro).Activate
Sheets("datos").Select
Range("a13").PasteSpecial xlPasteValues
Range("b13").Select
Do While ActiveCell.Offset(0, -1).Value <> ""
ActiveCell.Value = Date & "--" & Time
ActiveCell.Offset(1, 0).Select
Loop
ActiveWorkbook.Close True
Application.CutCopyMode = False
End Sub

recuerda finalizar la consulta

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas