Máximos colaboradores

Private Sub txtFecha_Change() With Hoja3.Range("A1").CurrentRegion uf = .Range("A" & Rows.Count).End(xlUp).Row .Columns("E:E").NumberFormat = "m/d/yyyy" .AutoFilter 5, txtFecha.Value Hoja1.Range("A1").CurrentRegion.Delete .SpecialCells(12).Copy Hoja1.Range("A1") ListTabla.RowSource = Hoja1.Range("A1"). _ CurrentRegion.Offset(1).Address(, , , 1) .AutoFilter .Columns("E:E").NumberFormat = "m/d/yyyy h:mm" End With End Sub Registro de Entradas y Salidas - copia.xlsm

Que tal, me permito proponer esta solución alternativa: =LET(_u, UNICOS(A2:A27), APILARH(_u, MAP(_u, LAMBDA(i, UNIRCADENAS(CARACTER(10),,FILTRAR(B2:B27&TEXTO(C2:C27,"-(0)"), A2:A27=i)))))) Asimismo, adjunto otra propuesta de solución empleando Power Qyery. Espero le sea útil. Agrupar y Concatenar (PQ solucion).xlsx

Hola OCTAVIO GONZALEZ saludos Arekin Prueba con este archivo. Saludos. ORDEN 1 ó 0_tor.xlsx

Parece ser cosa de la memoria y recursos de tu PC. Igual intenta así: Sub SumarEnRangoOptimizado() Dim folderPath As String Dim fileName As String Dim wb As Workbook Dim ws As Worksheet ' Carpeta que contiene los archivos folderPath = "D:\Carpeta\" ' Deshabilitar actualizaciones de pantalla y cálculos automáticos Application.ScreenUpdating = False Application.Calculation = xlCalculationManual ' Crear una instancia de Excel Application ' Set excelApp = CreateObject("Excel.Application") ' excelApp.DisplayAlerts = False ' Desactivar las alertas ' Iterar sobre los archivos en la carpeta fileName = Dir(folderPath & "\*.xlsx") Do While fileName <> "" ' Abrir el archivo Set wb = Workbooks.Open(folderPath & "\" & fileName) Set ws = wb.Sheets(1) ' Primera hoja de trabajo ' Aplicar la fórmula directamente en el rango With ws .Range("A3239:D3850").Formula = "=A$3238 + (ROW()-3238)" .Range("A3239:D3850").Value = .Range("A3239:D3850").Value ' Convertir las fórmulas en valores End With ' Cerrar el archivo sin guardar cambios wb.Close SaveChanges:=True Set ws = Nothing Set wb = Nothing ' Obtener el siguiente archivo en la carpeta fileName = Dir Loop ' Cerrar la instancia de Excel Application ' excelApp.Quit ' Set excelApp = Nothing ' Habilitar actualizaciones de pantalla y cálculos automáticos Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic MsgBox "La operación se ha completado en todos los archivos de la carpeta.", vbInformation End Sub Comentas

En ese caso es parece que está intentando cerrar un libro (wb) que ya se ha liberado. Así que lo que podría agregar entonces es verificar el objeto antes de cerrarlo, intenta modificar el código: ' Cerrar el archivo sin guardar cambios If Not wb Is Nothing Then wb.Close SaveChanges:=True Set wb = Nothing End If Algo así verificará si el objeto wb existe (If Not wb Is Nothing) antes de intentar cerrarlo (wb.Close SaveChanges:=True). Si wb no existe, entonces el código para cerrarlo no se ejecutará, tratando de evitar el error

Prueba y comenta Sub SumarEnRangoOptimizado() Dim folderPath As String Dim fileName As String Dim excelApp As Object Dim wb As Object Dim ws As Object Dim rng As Object ' Carpeta que contiene los archivos folderPath = "D:\Carpeta\" ' Deshabilitar actualizaciones de pantalla y cálculos automáticos Application.ScreenUpdating = False Application.Calculation = xlCalculationManual ' Crear una instancia de Excel Application On Error Resume Next ' Manejar errores al intentar conectar con una instancia existente Set excelApp = GetObject(, "Excel.Application") On Error GoTo 0 ' Reactivar la gestión de errores normales si no se encuentra ninguna instancia existente If excelApp Is Nothing Then Set excelApp = CreateObject("Excel.Application") excelApp.DisplayAlerts = False ' Desactivar las alertas End If ' Iterar sobre los archivos en la carpeta fileName = Dir(folderPath & "\*.xlsx") Do While fileName <> "" ' Abrir el archivo Set wb = excelApp.Workbooks.Open(folderPath & "\" & fileName) Set ws = wb.Sheets(1) ' Primera hoja de trabajo ' Aplicar la fórmula directamente en el rango With ws Set rng = .Range("A3239:D3850") With rng .Formula = "=A$3238 + (ROW()-3238)" .Value = .Value ' Convertir las fórmulas en valores End With End With ' Cerrar el archivo sin guardar cambios wb.Close SaveChanges:=True ' Obtener el siguiente archivo en la carpeta fileName = Dir Loop ' Cerrar la instancia de Excel Application excelApp.Quit Set excelApp = Nothing ' Habilitar actualizaciones de pantalla y cálculos automáticos Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic MsgBox "La operación se ha completado en todos los archivos de la carpeta.", vbInformation End Sub

Hola, no tengo experiencia con ese error así que lo busque en Google y me devolvió esto: El error ‘-2147023170(800706be) generalmente ocurre cuando se intenta acceder a un objeto que ya no está disponible. Entonces no estoy seguro que lo siguiente funcione pero parece que al ser tantos archivos ocupa demasiada memoria en cada iteración del bucle. Si es así lo que podría recomendarte sería establecer los objetos de excel como wb y ws en el NOTHING después de que ya los uso. Algo así: ' Cerrar el archivo sin guardar cambios wb.Close SaveChanges:=True ' Liberar la memoria Set ws = Nothing Set wb = Nothing Además: ' Cerrar la instancia de Excel Application excelApp.Quit Set excelApp = Nothing Como mencionaba no estoy seguro que funcione pero es una idea, es con lo que puedo participar en tu consulta.