UniversoExcelForo

Respuesta a consultas.
Fecha de creación: 09.Abril.2012

Fundadores: Wibly,Tyno,Servando,Sakkar,Rosendo2,RMaximo,Railar,Mcoronel,Ioyama,Igtelo,Hugotron,Drochar,Dedos,Alberto,Adolfo

No se pueden hacer consultas de Excel o VBA por mensaje privado.
Utiliza el botón buscar del foro y te ahorras tiempo para obtener "ayuda".

No estás conectado. Conéctate o registrate

Ver el tema anterior Ver el tema siguiente Ir abajo  Mensaje [Página 1 de 1.]

Lehoi


Hola a todos

Estoy usando esta macro para comprobar en todas las hojas a partir de la hoja 7, en busca de ciertos valores.
El problema viene cuando elimino las hojas y agrego nuevas hojas, cuando ejecuto la macro de nuevo se borra los datos antiguos (en un principio ese era mi objetivo).

Me gustaría mantener esos datos existentes y anexar los datos extraídos de las hojas nuevas después de los datos extraídos de las viejas (las hojas borrados).
Los nuevos datos se añadirían tras los datos existentes en las mismas columnas.

He hecho varias pruebas pero no logro conseguirlo  Embarassed .
Este es el código:
Código:
Sub Extract_alerta() 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim numero_alerta As Integer
ThisWorkbook.Sheets("alarms").Range("A2:A50000").Value = ""
ThisWorkbook.Sheets("alarms").Range("B2:B50000").Value = ""
ThisWorkbook.Sheets("alarms").Range("C2:C50000").Value = ""
ThisWorkbook.Sheets("alarms").Range("D2:D50000").Value = ""
ThisWorkbook.Sheets("alarms").Range("F2:F50000").Value = ""
ThisWorkbook.Sheets("alarms").Range("H2:H50000").Value = ""
ThisWorkbook.Sheets("alarms").Range("J2:J50000").Value = ""
ThisWorkbook.Sheets("alarms").Range("L2:L50000").Value = ""
ThisWorkbook.Sheets("alarms").Range("N2:N50000").Value = ""
ThisWorkbook.Sheets("alarms").Range("P2:P50000").Value = ""
ThisWorkbook.Sheets("alarms").Range("R2:R50000").Value = ""
ThisWorkbook.Sheets("alarms").Range("S2:S50000").Value = ""
ThisWorkbook.Sheets("alarms").Range("T2:T50000").Value = ""
ThisWorkbook.Sheets("alarms").Range("U2:U50000").Value = ""
ThisWorkbook.Sheets("alarms").Range("V2:V50000").Value = ""
ThisWorkbook.Sheets("alarms").Range("W2:W50000").Value = ""
ThisWorkbook.Sheets("alarms").Range("X2:X50000").Value = ""
ThisWorkbook.Sheets("alarms").Range("Y2:Y50000").Value = ""
ThisWorkbook.Sheets("alarms").Range("Z2:Z50000").Value = ""
numero_alerta = 2
For x = 7 To Worksheets.Count
For y = 26 To 75
If ThisWorkbook.Sheets(x).Cells(7, y).Value > Range("I_MIN").Value And _
ThisWorkbook.Sheets(x).Cells(7, y).Value < Range("I_MAX").Value And _
ThisWorkbook.Sheets(x).Cells(11, y).Value > Range("M_MIN").Value And _
ThisWorkbook.Sheets(x).Cells(11, y).Value < Range("M_MAX").Value Then
ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "A").Value = numero_alerta - 1
ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "B").Value = ThisWorkbook.Sheets(x).Cells(1, y)
ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "C").Value = ThisWorkbook.Sheets(x).Cells(2, y)
ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "D").Value = ThisWorkbook.Sheets(x).Cells(3, y)
ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "F").Value = ThisWorkbook.Sheets(x).Cells(5, y)
ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "H").Value = ThisWorkbook.Sheets(x).Cells(7, y)
ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "J").Value = ThisWorkbook.Sheets(x).Cells(9, y)
ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "L").Value = ThisWorkbook.Sheets(x).Cells(11, y)
ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "N").Value = ThisWorkbook.Sheets(x).Cells(13, y)
ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "P").Value = ThisWorkbook.Sheets(x).Cells(15, y)
ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "R").Value = ThisWorkbook.Sheets(x).Cells(17, y)
ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "S").Value = ThisWorkbook.Sheets(x).Cells(18, y)
ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "T").Value = ThisWorkbook.Sheets(x).Cells(19, y)
ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "U").Value = ThisWorkbook.Sheets(x).Cells(20, y)
ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "V").Value = ThisWorkbook.Sheets(x).Cells(21, y)
ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "W").Value = ThisWorkbook.Sheets(x).Cells(22, y)
ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "X").Value = ThisWorkbook.Sheets(x).Cells(23, y)
ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "Y").Value = ThisWorkbook.Sheets(x).Cells(24, y)
ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "Z").Value = ThisWorkbook.Sheets(x).Cells(25, y)
numero_alerta = numero_alerta + 1
End If
Next
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

He solicitado ayuda aquí http://www.mrexcel.com/forum/excel-questions/942598-how-modify-macro-append-new-data-keep-old-data.html pero la solución que me dieron me da error y además creo por el nuevo código, que entendieron que yo quería añadir los nuevos datos en nuevas columnas a partir de la última usada.

Saludos

Igtelo


Hola Lehoi.

Según el enlace que das, ya está resuelto ¿O no?. Nos dices que es lo que no te funciona y vemos...

Saludos
Ignacio Téllez

Lehoi


Hola Igtelo, encantado de volverte a leer

Efectivamente ya está funcionando ok, no había respondido por aquí porque me he liado probando el código nuevo hasta ver que todo iba perfecto antes de poner algo aquí que tuviese errores.

Añado el código por si a alguien le puede servir de algo. Reconozco que estos códigos tan individualizados no suelen ser de mucha ayuda la verdad, pero algo siempre se puede aprovechar.

Este código incluso tiene otra característica nueva y es que mediante un bucle For ahora además de añadir los nuevos datos a continuación de los existentes, si al buscar en las hojas detecta que el nombre de la hoja está en una lista, la salta y continua a la siguiente, así no hay peligro de reanalizar la misma hoja varias veces. 

Código:
Sub Extract_Alarms()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim numero_alerta As Integer
    Dim LR As Long

    LR = ThisWorkbook.Sheets("alarms").Cells(Rows.Count, "A").End(xlUp).Row
    numero_alerta = LR + 1

    For x = 7 To Worksheets.Count
        forbidden_name = 0
        For Each name_s In ThisWorkbook.Sheets("Main").Range("L8:M501").Cells
            If (ThisWorkbook.Sheets(x).Name = name_s.Value) Then
                 forbidden_name = 1
                 Exit For
            End If
        Next name_s
        If (forbidden_name = 0) Then
            For y = 26 To 75
                If ThisWorkbook.Sheets(x).Cells(7, y).Value > Range("IP_MIN").Value And _
                    ThisWorkbook.Sheets(x).Cells(7, y).Value < Range("IP_MAX").Value And _
                    ThisWorkbook.Sheets(x).Cells(11, y).Value > Range("MP_MIN").Value And _
                    ThisWorkbook.Sheets(x).Cells(11, y).Value < Range("MP_MAX").Value Then
                        ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "A").Value = numero_alerta - 1
                        ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "B").Value = ThisWorkbook.Sheets(x).Cells(1, y)
                        ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "C").Value = ThisWorkbook.Sheets(x).Cells(2, y)
                        ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "D").Value = ThisWorkbook.Sheets(x).Cells(3, y)
                        ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "F").Value = ThisWorkbook.Sheets(x).Cells(5, y)
                        ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "H").Value = ThisWorkbook.Sheets(x).Cells(7, y)
                        ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "J").Value = ThisWorkbook.Sheets(x).Cells(9, y)
                        ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "L").Value = ThisWorkbook.Sheets(x).Cells(11, y)
                        ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "N").Value = ThisWorkbook.Sheets(x).Cells(13, y)
                        ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "P").Value = ThisWorkbook.Sheets(x).Cells(15, y)
                        ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "R").Value = ThisWorkbook.Sheets(x).Cells(17, y)
                        ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "S").Value = ThisWorkbook.Sheets(x).Cells(18, y)
                        ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "T").Value = ThisWorkbook.Sheets(x).Cells(19, y)
                        ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "U").Value = ThisWorkbook.Sheets(x).Cells(20, y)
                        ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "V").Value = ThisWorkbook.Sheets(x).Cells(21, y)
                        ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "W").Value = ThisWorkbook.Sheets(x).Cells(22, y)
                        ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "X").Value = ThisWorkbook.Sheets(x).Cells(23, y)
                        ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "Y").Value = ThisWorkbook.Sheets(x).Cells(24, y)
                        ThisWorkbook.Sheets("alarms").Cells(numero_alerta, "Z").Value = ThisWorkbook.Sheets(x).Cells(25, y)
                        numero_alerta = numero_alerta + 1
                End If
            Next
        End If
    Next
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Un afectuoso saludo y gracias por querer echarme una mano como siempre!

Lehoi

Ver el tema anterior Ver el tema siguiente Volver arriba  Mensaje [Página 1 de 1.]

Permisos de este foro:
No puedes responder a temas en este foro.