Copiar y pegar en otro libro sin sobreescribir

[jek]

Estoy tratando de crear una macro para ir almacenando datos en otro libro de excel sin sobreescribir los datos. Estoy utilizando esta rutina y no lo logro. No se cual es el error. 

Sub CopiarCeldas()
 
'Definir objetos a utilizar
Dim wbDestino As Workbook, _
    wsOrigen As Excel.Worksheet, _
    wsDestino As Excel.Worksheet, _
    rngOrigen As Excel.Range, _
    rngDestino As Excel.Range
     
'Indicar el libro de Excel destino
Set wbDestino = Workbooks.Open("C:\JORGE\PEDIDOS DE QUIMICOS\DATOS.xlsx")
 
'Activar este libro
ThisWorkbook.Activate
 
'Indicar las hojas de origen y destino
Set wsOrigen = Worksheets("Analysis")
Set wsDestino = wbDestino.Worksheets("Sheet1")
 
'Indicar la celda de origen y destino
Const celdaOrigen = "A1"
Const celdaDestino = "A1"

 
'Inicializar los rangos de origen y destino
Set rngOrigen = wsOrigen.Range(celdaOrigen)
Set rngDestino = wsDestino.Range("A1").End(xlDown).Offset(1, 0)

 
'Seleccionar rango de celdas origen
rngOrigen.Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
 
'Pegar datos en celda destino
rngDestino.PasteSpecial xlPasteAll
Application.CutCopyMode = False
 
'Guardar y cerrar el libro de Excel destino
wbDestino.Save
wbDestino.Close
 
End Sub

[rolano]

Hola, donde te da el error. Recuerda que en el archivo origen donde esta la macro tienes que tener una hoja con nombre "analysis" y en el archivo destino una hoja con nombre "sheet1".