Copiar selección entre archivos

[JFlor]

Buenas tardes,

He estado buscando y tratando de adaptar el código que he podido encontrar, pero no soy capaz de hacerlo y llevo bastante tiempo atascado con ello, por eso pido vuestra ayuda.

Estoy creando una serie de macros que me permitan agilizar unas tareas repetitivas en mi trabajo. Una de ellas es la de exportar una sección de la hoja excel a un libro distinto, qué, si existe el libro añade la información en una hoja nueva y si no existe, creará el libro.

El principal problema lo tengo en que no sé como recuperar la información desde el archivo que ejecuto la macro. No sé si existe la forma de tener un puntero apuntando al archivo desde el que ejecutas la macro para luego recuperar ese libro o como he de hacerlo.

Mi código es este:

Sub ExportaSeccion()

    Dim ruta, HojaNueva As String

    Dim wbkLlama As Workbook ' para guardar el libro desde el que llamamos


    'definición de variables

    wbkLlama = ActiveWoorkbook ' guardamos el libro desde el que llamamos

    Nombre = Range("AU3") ' nombre con que llamamos el archivo destino, lo tengo en la celda AU3 del archivo origen

    ruta = ThisWorkbook.Path & "/" & Nombre & ".xlsx" 'ruta donde guardamos el archivo

    HojaNueva = Range("AU2") 'nombre para la hoja nueva


    ' comprobar si el archivo existe

   If Dir(ruta, vbArchive) <> "" Then ' exite, entonces lo abro y le añado la hoja

    Workbooks.Open Filename:=ruta

    Worksheets.Add.Name = HojaNueva


    Else ' no existe, lo creo y le borro las hojas que sobran

    Workbooks.Add

    'Guardar el libro

    ActiveWorkbook.SaveAs Filename:=ruta

    'Eliminar las hojas sobrantes

    Application.DisplayAlerts = False

    Sheets(Array("Hoja2", "Hoja3")).Select

    ActiveWindow.SelectedSheets.Delete

    ActiveSheet.Name = HojaNueva

    End If


   'Aquí es donde debería de seleccionar el rango desde el libro inicial

   wbkLlama.ActiveSheet.Range("Bk4:Bu209").Select

    Selection.Copy


    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Selection.PasteSpecial Paste:=xlPasteFormats

    ActiveWorkbook.Save

    ActiveWorkbook.Close

End Sub[/CODE]

Muchas gracias de antemano por vuestra ayuda.

[Antoni]

_________________________________________________________________

Sub ExportaSeccion()

    Dim ruta, HojaNueva As String


    'definición de variables

  Nombre = Range("AU3") ' nombre con que llamamos el archivo destino,

                        ' lo tengo en la celda AU3 del archivo origen

  ruta = ThisWorkbook.Path & "\" & Nombre & ".xlsx" 'ruta donde guardamos el archivo

  HojaNueva = Range("AU2")                          'nombre para la hoja nueva


    ' comprobar si el archivo existe

  If Dir(ruta, vbArchive) <> "" Then ' exite, entonces lo abro y le añado la hoja

      Workbooks.Open Filename:=ruta

      Worksheets.Add.Name = HojaNueva

  Else ' no existe, lo creo y le borro las hojas que sobran

      Workbooks.Add

      'Guardar el libro

      ActiveWorkbook.SaveAs Filename:=ruta

      'Eliminar las hojas sobrantes

      Application.DisplayAlerts = False

      Sheets(Array("Hoja2", "Hoja3")).Select

      ActiveWindow.SelectedSheets.Delete

      ActiveSheet.Name = HojaNueva

  End If



   ThisWorkbook.ActiveSheet.Range("BK4:BK209").Copy _

   ActiveWorkbook.ActiveSheet.Range("BK4:BK209")



  ActiveWorkbook.Save

  ActiveWorkbook.Close

End Sub

[/CODE]

___________________________________________________________________

.

[JFlor]

Muchas GRACIAS Macro Antonio, lo probaré desde el PC y te preguntaré si tengo alguna duda.

Saludos

[JFlor]

Buenos días Macro Antonio,

he probado tu código y efectivamente lo copia, muchas gracias. Tengo un pequeño problema:

La selección que quiero copiar esta referenciada a otra parte de la hoja origen, entonces ahora al copiarlo al nuevo archivo necesitaría copiar los valores y mantener el formato por eso tenía este código en mi código inicial

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Selection.PasteSpecial Paste:=xlPasteFormats

¿podrías ayudarme a que a la hora de copiar lo mantenga? he probado haciéndolo mediante otra macro que seleccione toda la hoja copie y pegue los valores y guarde el formato, pero no consigo los valores, me copia #¡REF!.

He modificado tu código diciendole que el rango donde pega es A1:A205, creo que no, pero quizás influye.

Muchas gracias de nuevo.

[Antoni]

________________________________________________________

  ThisWorkbook.ActiveSheet.Range("A1:A10").Copy

  ActiveWorkbook.ActiveSheet.Range("A1:A10").PasteSpecial Paste:=xlValues

  ActiveWorkbook.ActiveSheet.Range("A1:A10").PasteSpecial Paste:=xlFormats

[/CODE]

_________________________________________________________

[JFlor]

Muchas gracias Macro, me funcionó perfectamente pero al tratar de guardar la macro en el PERSONAL.XLSB en vez de en el propio documento no hace nada, es como si no copiase nada, imagino que tiene que ver con las referencias a los archivos.

¿Como podría solucionar esto? si se puede, si no, lo mantengo en el libro pero preferiría que no para que únicamente se pueda ejecutar desde mi ordenador.

Lo dicho, muchas gracias y disculpa por ir haciendo las preguntas por partes.

Un saludo.

[Antoni]

__________________________________________

Lo siento JFlor, pero no trabajo nunca con el libro Personal.

Lo uso solo como almacén de utilidades y otros códigos.

__________________________________________

[JFlor]

Perfecto Macro Antonio, investigaré a ver, muchas gracias por tu ayuda.

Un saludo.