Estimados, muy buen dia.

Les comento que estoy trabajando a una macro, la cual consiste en buscar datos de otro libro de excel, mediante el comando ActiveWorkbook.Path.

Necesito que busque 5 archivos distintos, los cuales están nombrados con números del 1 al 5. Para hacer esto, copie 5 veces el código ActiveWorkbook. El problema es que si un día solo tengo 3 archivos, la macro arroja un error al no encontrar el cuarto archivo. 

Probe utilizando el comando On Error GoTo "primero" , y al final primero:

Funcionó con el primer codigo, pero el segundo utilice On Error GoTo "segundo, y no lo considera.

Sub TEST()
'
' TEST Macro


Dim wbDestino As Workbook, _
    wsOrigen As Excel.Worksheet, _
    wsDestino As Excel.Worksheet, _
    rngOrigen As Excel.Range, _
    rngDestino As Excel.Range
     
Sheets("DATA").Select
Range("A1").Select
    
On Error GoTo primero
Set wbDestino = Workbooks.Open(ActiveWorkbook.Path & "/EXCEL/1", Local:=True)
     Set wsDestino = wbDestino.Worksheets("1")
Set wsOrigen = Worksheets("1")
Const celdaOrigen = "A1"
Const celdaDestino = "A1"
Set rngOrigen = wsOrigen.Range(celdaOrigen)
Set rngDestino = wsDestino.Range(celdaDestino)
rngOrigen.Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ThisWorkbook.Activate
    ActiveSheet.Paste
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    wbDestino.Close
    
primero:

'SEGUNDO ARCHIVO'

On Error GoTo segundo
Set wbDestino = Workbooks.Open(ActiveWorkbook.Path & "/EXCEL/2", Local:=True)
    Set wsDestino = wbDestino.Worksheets("2")
Set wsOrigen = Worksheets("2")
Set rngOrigen = wsOrigen.Range(celdaOrigen)
Set rngDestino = wsDestino.Range(celdaDestino)
rngOrigen.Select
ActiveCell.Offset(1, 0).Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ThisWorkbook.Activate
    ActiveSheet.Paste
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    wbDestino.Close
        
segundo:

'TERCER ARCHIVO'

On Error GoTo tercero
Set wbDestino = Workbooks.Open(ActiveWorkbook.Path & "/EXCEL/3", Local:=True)
    Set wsDestino = wbDestino.Worksheets("3")
Set wsOrigen = Worksheets("3")
Set rngOrigen = wsOrigen.Range(celdaOrigen)
Set rngDestino = wsDestino.Range(celdaDestino)
rngOrigen.Select
ActiveCell.Offset(1, 0).Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ThisWorkbook.Activate
    ActiveSheet.Paste
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    wbDestino.Close
    
tercero:

End Sub

 

Saludos!

 

 

 

@manzano ejecute el código con dos archivo así y me funciono

Sub TEST()
'
' TEST Macro


Dim wbDestino As Workbook, _
    wsOrigen As Excel.Worksheet, _
    wsDestino As Excel.Worksheet, _
    rngOrigen As Excel.Range, _
    rngDestino As Excel.Range
     
Sheets("DATA").Select
Range("A1").Select
 On Error Resume Next
Set wbDestino = Workbooks.Open(ActiveWorkbook.Path & "/1", Local:=True)
     Set wsDestino = wbDestino.Worksheets("1")
Set wsOrigen = Worksheets("1")
Const celdaOrigen = "A1"
Const celdaDestino = "A1"
Set rngOrigen = wsOrigen.Range(celdaOrigen)
Set rngDestino = wsDestino.Range(celdaDestino)
rngOrigen.Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ThisWorkbook.Activate
    ActiveSheet.Paste
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    wbDestino.Close
    
primero:

'SEGUNDO ARCHIVO'

'On Error GoTo segundo
Set wbDestino = Workbooks.Open(ActiveWorkbook.Path & "/2", Local:=True)
    Set wsDestino = wbDestino.Worksheets("2")
Set wsOrigen = Worksheets("2")
Set rngOrigen = wsOrigen.Range(celdaOrigen)
Set rngDestino = wsDestino.Range(celdaDestino)
rngOrigen.Select
ActiveCell.Offset(1, 0).Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ThisWorkbook.Activate
    ActiveSheet.Paste
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    wbDestino.Close
        
segundo:

'TERCER ARCHIVO'

'On Error GoTo tercero
Set wbDestino = Workbooks.Open(ActiveWorkbook.Path & "/3", Local:=True)
    Set wsDestino = wbDestino.Worksheets("3")
Set wsOrigen = Worksheets("3")
Set rngOrigen = wsOrigen.Range(celdaOrigen)
Set rngDestino = wsDestino.Range(celdaDestino)
rngOrigen.Select
ActiveCell.Offset(1, 0).Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ThisWorkbook.Activate
    ActiveSheet.Paste
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    wbDestino.Close
Application.CutCopyMode = False
tercero:

End Sub

solo me manda este mensaje

 

 

saludos isidro

Puedes probar dejando solo el archivo "1" a ver si te pasa al final de la macro sin error?

Lo más adecuado para este caso es utilizar la función Dir() para comprobar si el archivo existe o no:

If Dir(nombre de archivo) = Empty Then 'El archivo no existe

Me llamaréis oportunista, pero venía a decir lo mismo que @Antoni . No por el hecho de encontrar o no el archivo, sino porque no soy nada partidario de ese tipo de control de errores.

El control de errores, para mí y en contadas excepciones, no tiene sentido y oculta una desidia importante a la hora de programar. ¿Para que andar con "On Error..." si hay una forma de encontrar el fichero, y si es así abrirlo y si no pasar al siguiente?

Aparte que al final no sabes si el control de errores sigue activo o no, o si por controlar el error de esa manera, has pasado por encima de algo?

Quiero decir que si, como en este caso, lanzo la apertura de todos los archivos que necesito sin saber si existen o no, y como sé que a veces va a pasar que no, intento controlarlo con "control de errores"... ¿No será mejor buscar una forma mediante código de comprobar si existe o no y evitar el posible error?

Bueno, es solo mi punto de vista

gracias @Haplox  por tu punto de vista lo tomaremos en cuenta para no usar ese control de errores y buscaremos una solución como la de @Antoni  o como todos los maestros que aquí comparte su sabiduría

saludos isidro

Ahora mismo, isidrod dijo:

lo tomaremos en cuenta para no usar ese control de errores

A ver, que es una vista y opción personal. Si alguien se encuentra cómodo con ello, pues es su forma de trabajar ?. No puedes controlar TODOS los errores posibles, por eso para mí lo primero es pensar en los que pueden ocurrir por lo que se necesita y lo que podemos encontrar al buscar, abrir, sumar, etc. e intentar adelantarme a que se produzcan intentando controlar todas las variables posibles que en ese momento se me ocurren.

Por supuesto habrá muchas más variables que irán apareciendo con el uso, no podemos controlar TODAS de una vez o seríamos unos auténticos genios ?. Y como con el control de errores (del que estamos hablando, "On Error Goto...") tampoco los vamos a solucionar todos, pero sí podemos estar seguros de que pasaremos por encima de algo de lo que no queremos pasar... pue eso ?

 

 

Dios mio, leer esos comentarios me hace ver que soy menos que un novato jeje, pero es excelente saber que se puede aprender un monton cambiando mi logica.

 

Volviendo al tema, como se aplica Dir en ese codigo en especifico?

Y para ir mas alla, hay algun tema del foro en donde haya un glosario con ese tipo de funciones (si esque realmente se llama funcion).

 

Como dije, he estado haciendo macros con un conocimiento nulo y ahora estoy aprendiendo mas para que mi equipo de trabajo optimize sus tiempos productivos.

 

Saludos.

@Haplox,

Exactamente lo que mencionas es una buena partida para programar "MEJOR", ya que una vez intente hacer mi "Control de Errores" sobre un proyecto ya "terminado" pensando que seria un PLUS y al final me di cuenta que era demasiado código y más complejo... después de un mes de trabajar en ello...

Y regrese como estaba al principio... 

Saludos.

gracias @Haplox por tus sabios consejos

 

 

 

Hace 15 horas, manzano dijo:

como se aplica Dir en ese codigo en especifico?

Pués sería algo como lo siguiente...
 

Dim Fichero As String

For i = 1 To 5
Fichero = Dir(ThisWorkbook.Path & "\" & i & ".xlsx", vbArchive)
    If Fichero <> "" Then
        Set wbDestino = WorkBooks.Open(Fichero)
    
        'TU CÓDIGO....'
        
    End If
Fichero = Dir()
Next i

 

 

@Haplox disculpa mi ignorancia, pero el directorio del archivo en que parte se coloca?

Hace 15 minutos , manzano dijo:

pero el directorio del archivo en que parte se coloca

Si es el EXCEL ese que tenías sería:

Fichero = Dir(ThisWorkbook.Path & "\EXCEL\" & i & ".xlsx", vbArchive)

Estimado, hice la formula como me sugeriste pero no abre el archivo 1, se salta el codigo y al final arroja una alerta.

 

Sub Makro1()
'


Dim Fichero As String

For i = 1 To 5
Fichero = Dir(ThisWorkbook.Path & "\EXCEL\" & i & ".xlsx", vbArchive)
    If Fichero <> "" Then
        Set wbDestino = Workbooks.Open(Fichero)
    
    Set wsDestino = wbDestino.Worksheets("1")
Set wsOrigen = Worksheets("1")
Const celdaOrigen = "A1"
Const celdaDestino = "A1"
Set rngOrigen = wsOrigen.Range(celdaOrigen)
Set rngDestino = wsDestino.Range(celdaDestino)
rngOrigen.Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ThisWorkbook.Activate
    ActiveSheet.Paste
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    
        
    End If
Fichero = Dir()
Next i


End Sub

No dices dónde te da el error, de momento prueba así:

For i = 1 To 5
Fichero = Dir(ThisWorkbook.Path & "\EXCEL\" & i & ".xlsx", vbArchive)
    If Fichero <> "" Then
        Set wbDestino = Workbooks.Open("ThisWorkbook.Path & "\EXCEL\" & Fichero)

De todas las maneras tienes un pequeño jaleo con las constantes, los rangos, etc ?

Perdona, al llegar a la linea marcada arroja una alerta de sintaxis.

 

En cuanto al error anterior, 

 

Hace 19 minutos , manzano dijo:

En cuanto al error anterior, 

Te sobran unas comillas justo delante de ThisWorkBook:

WorkBooks.Open("ThisWrokBook.Path....)

Estimado,

Arme toda el código tal cual y no me abre ningún archivo, solo hace el bucle 5 veces y se devuelve al principio.

 

Alguna idea de porque no funciona? se supone que el directorio esta bien ya que probé quitando la formula  If Fichero <> "" Then y la macro abría correctamente el archivo...

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
     

For i = 1 To 5
Fichero = Dir(ThisWorkbook.Path & "\EXCEL\" & i & ".xlsx", vbArchive)
    If Fichero <> "" Then
        Set wbDestino = Workbooks.Open(ThisWorkbook.Path & "\EXCEL\" & Fichero)

Set wbDestino = Workbooks.Open(ActiveWorkbook.Path & "/EXCEL/", Local:=True)

    Set wsDestino = wbDestino.Worksheets("1")
Set wsOrigen = Worksheets("1")
Const celdaOrigen = "A1"
Const celdaDestino = "A1"
Set rngOrigen = wsOrigen.Range(celdaOrigen)
Set rngDestino = wsDestino.Range(celdaDestino)
rngOrigen.Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ThisWorkbook.Activate
    ActiveSheet.Paste
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    
    End If
Fichero = Dir()
Next i


End Sub

 

Hace 4 horas, manzano dijo:

Alguna idea de porque no funciona?

Porque tienes un jaleo de macro importante... . Mejor sube tu fichero origen y uno de los destinos y explica qué quieres hacer o copiar

 

Mira, he re formulado todo.

 

Quiero que la formula que indiqué abajo se aplique abriendo otros libros excel, los cuales estarán enumerados del 1 al 5.

La idea es que abra el libro 1, copie su contenido y lo pegue en mi libro base, luego que lo cierre y pase al libro 2, copie y pegue una celda mas abajo de lo que ya pegue con el libro 1. Así sucesivamente. Esta el caso que un día solo tenga el libro 1, 2 y 3, y que el 4 y 5 no estén presentes.

El directorio donde guardare los archivos es \Users\a0m01cb\Desktop\EXCEL

    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    ThisWorkbook.Activate
    Range("A1").Select
    ActiveSheet.Paste
    wbDestino.Close
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select

Espero que ahora se entienda, la formula con mucho jaleo anterior la saque de una pagina web, y tienes razon, ni yo mismo lo entendía.

Ahora puse la información exacta, sin códigos que quizá no eran necesarios.

Hola,

No entiendo Nada...

 

Saludos.

Hace 6 horas, manzano dijo:

Ahora puse la información exacta

No, no la has puesto. Si no subes un archivo de ejemplo, con los rangos que ocupas, si hay saltos entre líneas y demás, poco se puede hacer.

En ese código no se sabe qué has seleccionado, cuantas columnas, etc

Aquí te adjunto el excel base, el directorio donde tengo los archivos es C:\Users\a0m01cb\Desktop\EXCEL 

Quiero que después de abrir el archivo 1, pase a abrir el archivo 2, así consecutivamente hasta el archivo 5.

 

PRUEBA.xlsm

Te comparto los dos archivos que están dentro de la carpeta Excel.

1.csv 2.csv

Hace 6 horas, manzano dijo:

Te comparto los dos archivos que están dentro de la carpeta Excel.

Joder @manzano ... Cómo no te va a dar error si no son ficheros xlsx!!! Esa es una cosa por la que se empiezan los post pidiendo ayuda: EXPLICANDO LAS COSAS

Vale, vine a aprender, y en este mismo post ya estoy aprendiendo a como pedir ayuda correctamente  ?

Favor comprende, tengo conocimiento precario de vba, y quiza formulé la pregunta sin yo mismo entenderla al no conocer la base teoria....

Editado el el 17 de noviembre5 años por manzano