Antoni

Si lo he entendido: Pega los datos copiados del AS400 en otra parte de la hoja. Con una macro: Concatena las 2 columnas en una de ellas Elimina la otra Copia los datos Pégalos en la tabla.

Sub Eliminar_Filas_1() Dim Filas As Integer Application.ScreenUpdating = False Sheets("Resultados exportados").Select col = "A" texto = Array( _ "QHP Standard 1", _ "QHP Standard 2", _ "QHP Standard 3", _ "QHP Standard 4", _ "QHP Standard 5") Application.ScreenUpdating = False For i = Range(col & Rows.Count).End(xlUp).Row To 1 Step -1 For t = 0 To UBound(texto) If LCase(Cells(i, col)) = LCase(texto(t)) Then Filas = Filas + 1 Rows(i).Delete Exit For End If Next Next Application.ScreenUpd

Basta con añadir una condición más a la macro: Sub Acumular() Application.ScreenUpdating = False ActiveSheet.Copy after:=ActiveSheet For x = Range("E" & Rows.Count).End(xlUp).Row To 3 Step -1 i1 = InStrRev(Range("B" & x), " ") i2 = InStrRev(Range("B" & x - 1), " ") If i1 = 0 Then i1 = Len(Range("B" & x)) If i2 = 0 Then i2 = Len(Range("B" & x - 1)) If Left(Range("B" & x), i1) = Left(Range("B" & x - 1), i2) And _ Range("C" & x) = Range("C" & x - 1) Then '<----- Condición añadida ----------- Range("B" & x - 1) = Left(Range(

Abre el adjunto y pulsa sobre la flecha azul. InformeInstalaciones-24_11_2020.xlsm

Estoy muy liado con temas personales y no dispongo del tiempo necesario para este tema 😒, de momento, te tendrás que conformar con lo que hay. Bo dia dende Bertamiráns. 🙂

Sub Acumular() Application.ScreenUpdating = False Range("A:C").Copy Range("E1") For x = Range("E" & Rows.Count).End(xlUp).Row To 3 Step -1 i1 = InStrRev(Range("E" & x), " ") i2 = InStrRev(Range("E" & x - 1), " ") If i1 = 0 Then i1 = Len(Range("E" & x)) If i2 = 0 Then i2 = Len(Range("E" & x - 1)) If Left(Range("E" & x), i1) = Left(Range("E" & x - 1), i2) Then Range("E" & x - 1) = Left(Range("E" & x - 1), i2) Range("F" & x - 1) = Range("F" & x - 1) + Range("F" & x) Range("E" & x).Resize(1, 3).Delete End If Ne

Sube tu archivo.

Tenía esto por ahí, si te interesa, este fin de semana intento estandarizarlo para poder ser usado en varios formularios. Pero un consejo, no te pierdas en adornos que en el fondo solo hacen que complicar las aplicaciones y no sirven para nada o casi para nada y reducen el rendimiento. Y desde el punto de aprendizaje no te aporta nada en absoluto. Redimensionar formulario Plus.xls

...............

Por el mismo precio también va incluido el botón de maximizar. 😂 Y no, no puede aparecer en la barra de tareas, que yo sepa. Minimizar.xlsm

Esta macro crea una copia de la última hoja. Sub CopyLastSheet() Sheets(Sheets.Count).Copy After:=Sheets(Sheets.Count) End Sub

Ejecuta la macro Títulos en una hoja vacía: Private Function GetProperties(file As String, propertyVal As Integer) As Variant Dim varfolder, varfile With CreateObject("Shell.Application") Set varfolder = .Namespace(Left(file, InStrRev(file, "\") - 1)) Set varfile = varfolder.ParseName(Right(file, Len(file) - InStrRev(file, "\"))) GetProperties = varfolder.GetDetailsOf(varfile, propertyVal) End With End Function '--------------------------------------------------------------------------------- Sub Títulos() Dim x As Integer For x = 1 To 40 Range("A" & x).Value = GetPropertie

.List(.ListCount -1, 1 ) = ComboProd.List(ComboProd.ListIndex, 1)

Te dejo una función que obtiene la propiedad 27 (Duración) de un archivo. Sub ObtenerDuración() Duración = GetDuration("F:\DSCN0256.AVI") '<---- Ejemplo de llamada End Sub '--------------------------------------------- Function GetDuration(file As String) As Variant With CreateObject("Shell.Application") Set varfolder = .Namespace(Left(file, InStrRev(file, "\") - 1)) Set varfile = varfolder.ParseName(Right(file, Len(file) - InStrRev(file, "\"))) GetDuration = varfolder.GetDetailsOf(varfile, 27) End With End Function Lista de archivos y carpetas.xlsm

La mejor manera de tratar un error es evitar que se produzca, o sea, evitar que el zoom pueda salirse de sus limites (10-400). Te dejo un ejemplo que te sirve para cualquier formulario, solo tienes que copiar el módulo UserformResize y añadir estas líneas en cada formulario: Private Sub UserForm_Initialize() MinZoom = 60: MaxZoom = 125 'Entre 10 y 400 ResizeWindowSettings Me, True End Sub Private Sub UserForm_Resize() UserForm_ResizeZoom Me End Sub Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean) RestoreZoom Me End Sub Nota: Con doble-click en el formulario,