Macro para copiar datos de varios libros

3 envíos / 0 nuevos
Último envío
Spikeai
Imagen de Spikeai
Offline
última acción: Hace 9 años 6 meses
alta: 20/08/2014 - 15:10
Puntos: 42
Macro para copiar datos de varios libros

Hola a todos, Espero darme a entender.

 

Tengo varios archivos que se encuentran en una ruta de intranet, periodicamente alguien une la información de estos archivos en un archivo local para trabajar.

Todos los archivos (tanto en linea como local) tienen hojas ocultas con acceso a base de datos para recuperar información actualizada y completar el formato.

A gradnes rasgos, la macro abre cada uno de los archivos en linea, copia las celdas necesarias y las pega en el archivo local mediante ciclos For y un If.

Ninguna de las columnas que estoy copiando tiene formulas o alguno de los datos recuperados de las conexiones de SQL.

Cuando ejecuto la macro, me arroja un error despues de pegar la información en el archivo loca, cuando intenta regresar al archivo origen. El error es el "13 - No coinciden los tipos".

Lei que ese error puede generarse cuando se llena la memoria y se "pierde coherencia". Hice la prueba con los mismos archivos pero de forma local y el error persiste.

 

El segmento donde me envia el error es el siguiente:

            Windows(macro).Activate

            ActiveWorkbook.Worksheets("Temporal").Select

            Range("A" & total).Select

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

                :=False, Transpose:=False

            Range("A" & total).Select

            

            'Regresamos al archivo origen para copiar la siguiente columna

            Windows(Serie).Activate 'Aqui es donde se genera el error

 

Adjunto el archivo para que tengan la imagen completa. 

 

Agradezco de antemano a todos y ojala alguien pueda ayudarme con este tema.

AdjuntoTamaño
File movimientos_internet.xlsm726.34 KB

Etiquetas: 

pacomegia
Imagen de pacomegia
Offline
última acción: Hace 17 horas 12 mins
Nivel 1 - 200 puntosNivel 2 - 500 puntosNivel 3 - 1000 puntosNivel 4 - 2000 puntosNivel 5 - 4000 puntosadministrador
alta: 27/12/2006 - 23:26
Puntos: 11175
workbooks en vez de windows

Para activar un libro u otro, prueba a utilizar la colección Workbooks en vez de Windows

WorkBooks(Serie).Activate

 

o mejor, utiliza una variable de objeto para referirte a un libro y al otro.

 

------
Ya sé Excel, pero necesito más.

Spikeai
Imagen de Spikeai
Offline
última acción: Hace 9 años 6 meses
alta: 20/08/2014 - 15:10
Puntos: 42
Re: Macro para copiar datos de varios libros

Gracias por la respuesta.

 

Pues cambie la colección a Workbooks, pero me seguia saliendo el error, y la variable "Serie" la tenia declarada como objeto.

 

Pero tus recomendaciones me dieron la respuesta, asigne un arreglo de string para guardar los nombres de los archivos previamente, y eso me corrigio el problema.

Adjunto el codigo por si a alguien le sirve (tiene algo de codigo basura, pero queria asegurar que procesara todo):

 

Sub Agrupa_movimientos()

'Macro para unificar datos de varios archivos en uno solo para su procesamiento

'Declaración de variables

    Dim Serie, subserie As Object

    Dim fila, i, total As Integer

    Dim copiar, rangos(1 To 16), macro, nombre, ruta, celdas(1 To 16), archivo(1 To 10) As String

'Comienza proceso

    'Asignación de valores y posición iniciales

    ActiveWorkbook.Worksheets("Datos").Select

    i = 1

    macro = Range("D10").Value

    nombre = Range("D6").Value

    total = 3

    'Ciclo For para almacenar las columnas a copiar

    For Each subserie In Range("F2:F17")

        celdas(i) = subserie

        i = i + 1

    Next

    'Ciclo For para almacenar los nombres de archivo que seran usados

    i = 1

    For Each Serie In Range("B2:B11")

        archivo(i) = Serie

        i = i + 1

    Next

'Comienza Ciclo para copiado de información

    For j = 1 To 10 

        'Se arma el String para abrir el archivo correcto

        ActiveWorkbook.Worksheets("Datos").Select

        ruta = nombre & archivo(j)

        'Abre el archivo del que se tomaran los datos

        Workbooks.Open Filename:=ruta

        'Codigo de retraso para actualización de información

        Call WaitOpen

        ActiveWorkbook.Worksheets("Plantilla").Select

        Range("C999").Select

        Selection.End(xlUp).Select

        fila = ActiveCell.Row

        If fila = 3 Then

            'Recorrido de arreglos para copiar columnas

            For i = 1 To 16

                rangos(i) = celdas(i) & "3"

                If i = 1 Then

                    copiar = rangos(i)

                Else

                    copiar = copiar & "," & rangos(i)

                End If

            Next

            Range(copiar).Copy

            'cambiamos de archivo para pergar los datos

            Workbooks(macro).Activate

            ActiveWorkbook.Worksheets("Plantilla").Select

            Range(celdas(i) & total).Select

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

                :=False, Transpose:=False

            Range("A" & total).Select

            'Regresamos al archivo origen para copiar la siguiente columna

            Workbooks(archivo(j)).Close (False)

        ElseIf fila > 3 Then

            'Recorrido de arreglos para copiar columnas

            For i = 1 To 16

                rangos(i) = celdas(i) & "3:" & celdas(i) & fila

                If i = 1 Then

                    copiar = rangos(i)

                Else

                    copiar = copiar & "," & rangos(i)

                End If

            Next

            Range(copiar).Copy

            'cambiamos de archivo para pergar los datos

            Workbooks(macro).Activate

            ActiveWorkbook.Worksheets("Temporal").Select

            Range("A" & total).Select

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

                :=False, Transpose:=False

            Range("A" & total).Select

            'Regresamos al archivo origen para copiar la siguiente columna

            Workbooks(archivo(j)).Close (False)

        Else

            Workbooks(archivo(j)).Close (False)

        End If

        'Asignamos la nueva posición de pegado para el archivo destino

        total = total + fila - 2

    Next

End Sub