Haplox

O sea, que para ganar tiempo me decidía a usar cmd, y me llevo comiendo la cabeza desde el principio Muchas gracias a todos, el lunes lo pruebo y digo algo

Este código es para buscar ficheros PDF. El que uso es el mismo adaptado a buscar fichero excel Sub BuscadorPDF(txtCarpetaPDF As control, txtNombrePDF As control) ' ********************************************** Range("A1:B1000").ClearContents ' SE BORRA EL RANGO A1:B1000 PARA COMENZAR CON LA HOJA LIMPIA ' ' ********************************************** 'Se establece el directorio de búsqueda 'Si se busca directorio se usa este, si no se busca directorio se usa el directorio por defecto If txtCarpetaPDF.Value = "" Then Directorio = "\\Prefi01\datos\HOJAS DE RUTA RELLENAS" ' Disco Duro y CARPETA TERMINAR CON \ Else Directorio = txtCarpetaPDF.Value End If 'Se establece el nombre del fichero a buscar (con comodines para búsquedas masivas) Filename2 = "\" & "*" & txtNombrePDF.Value & "*" & ".pdf" 'Se establece la ruta completa de búsqueda de búsqueda sPath = Directorio & Filename2 'Se realiza la búsqueda de los ficheros se copian a la Hoja activa Dim vIn, vOut(), i As Long, c As Range vIn = Filter(Split(CreateObject("WScript.Shell").exec("cmd /c Dir """ & sPath & """ /b /a-d /s").stdout.ReadAll, vbCrLf), ".") On Error GoTo Fin ReDim vOut(1 To 1 + UBound(vIn), 1 To 2) With CreateObject("Scripting.FileSystemObject") For i = 0 To UBound(vIn) vOut(1 + i, 1) = .GetParentFolderName(vIn(i)) vOut(1 + i, 2) = .GetBaseName(vIn(i)) & "." & .GetExtensionName(vIn(i)) Next i End With With Range("A2").Resize(UBound(vOut, 1), UBound(vOut, 2)) .Value = vOut End With 'Se establecen los títulos del ListBox Range("B1").Value = "ARCHIVO" Range("C1").Value = "CARPETA" Call BuscarCarpetas Columns("B").AutoFit Exit Sub Fin: 'Se no se encuentra el fichero se muestra el messagebox MsgBox " No se encontro " & Directorio & Filename2 End Sub

Te dejo solución @leones55 Copia de Libro1.xlsm

Es una macro del trabajo y ahora no tengo acceso a ella , lo siento @Riddle . Hasta el lunes no podría ser @digitalboy ¿Cómo o dónde tengo que implementar que use código UTF-8?

Dónde. ¿Por qué no subes tu archivo?

Qué tal @GALINHO , Solo tengo tiempo de mirar por encima y darte una respuesta rápida. Recueda que BUSCARV tiene su equivalenye propio en VBA WorkSheetFuction.VLookUp Funciona como BUSCARV pero con la notación de rangos y valores propios de VBA, así que puedes hacer un bucle For/Next desde la primera fila a buscar hasta la última que necesites: For i=14 to 19 valor=WorkSheetFuction.VLookUp(Cells(i,"Q"),Sheets(BDatos).Range("L3:N102"),0) ......

O sea @leones55 , qu al final lo que no quieres es lo que pides en el título, exportar la hoja, sino copiar un rango. En fin... Sub ExportarHoja() Dim wbOrigen As Workbook Dim wbDestino As Workbook Dim Ruta, Nombre as String Ruta=Cells(1,1) ultimaColumna = Sheets(4).Cells(1, Columns.Count).End(xlToLeft).Column ultimaFila=Sheets(4).Range("L" & Rows.Count).End(XlUp).Row Set wbOrigen=ThisWorkBook Set wbDestino=WorkBooks.Add wbOrigen.Worksheets(4).Range(Cells(1,1),Cells(ultimaFila,UltimaColumna)).Copy After:=wbDestino.Sheets(1) wbDestino.SaveAs Filename:=Ruta & Nombre End Sub Ahora te copia el rango de la hoja 4 desde A1 hasta la última línea de la última columna, sean cúal sean

Exactamente @digitalboy , pero yo no he guardado el archivo con ese nombre. Me explico: en el directorio, ese archivo tiene el nombre de HOJA DE RUTA_B.81925.126.FIJACIÓN TECHO.xlsx Cuando lo muestra en el listbox, aparece como: HOJA DE RUTA_B.81925.126.FIJACIàN TECHO.xlsx Supongo que VBA no reconoce la Ó (o acentuada) y cambia el caracter por "à" (ASCII 133). Así, al intentar abrirlo con él en el listbox seleccionado, VBA arroja el error de "fichero no encontrado" Pasa lo mismo con ficheros que incluyan la "Ñ". Aparecen en el listbox con un caracter ASCII que ahora no recuerdo, pero pasa lo mismo Por eso pensé que la solución era cambiar el nombre y quitár la "à" , pero a lo mejor es que los tiros ya no van por ahí

Daré por hecho que hablas de los nombres de fichero, porque tampoco lo has respondido y tampoco entiendo esto Sub ExportarHoja() Dim wbOrigen As Workbook Dim wbDestino As Workbook Dim Ruta, Nombre as String Dim ultimaColumna As Long Dim i% Application.ScreenUpdating=False Ruta=Cells(2,1) ultimaColumna = Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column Set wbOrigen=ThisWorkBook for i=1 to ultimaColumna Set wbDestino=WorkBooks.Add wbOrigen.Worksheets(1).Copy After:=wbDestino.Sheets(1) wbDestino.SaveAs Filename:=Ruta & Cells(1,i) wbDestino.Close Next i Application.ScreenUpdating=True End Sub Ahora la ruta está en la celda A2 y los nombres en las celdas A1 hasta la última que tengas escrita en esa fila (digamos M1, pero si hubiese más, tanbién te serviría)

No cerréis el tema, me estoy encontrando con problemas El problema es el siguiente: pensaba que el código de @Riddle modificaba directamente el texto en el fichero GUARDADO en el disco, y no... Le introduces un texto, sustituye los caracteres no válidos y se queda, digamos que "en el aire". Así que, nada, digo pués le asigno el valor obtenido a una variable y RENOMBRO el archivo en disco con lo nuevo. Pues tampoco. ¿Por qué? pues por qué el fichero antiguo es el que CONTIENE el caracter raro y VBA sigue sin reconocerlo (Error fichero no encontrado) He probado con "Name As" y fso.MoveFile y nada. Ahora ya no sé qué hacer fso.MoveFile ruta, DIRECTORY & "\" & nombre donde: ruta=\\Prefi01\datos\HOJAS DE RUTA RELLENAS\BERRADE\HOJA DE RUTA_B.81925.126.FIJACIàN TECHO.xlsx (DIRECTORY & "\" & nombre)= \\Prefi01\datos\HOJAS DE RUTA RELLENAS\BERRADE\HOJADERUTA_B.81925.126.FIJACINTECHO.xlsx Como véis las rutas son iguales, con el nombre cambiado. ¿Alguna idea? Gracias

A ver @JOSEMENDOZA2017 , nos mandas el archivo sin que hayas hecho NADA DE NADA... ni lo has intentado ¿Qué pretendes, que te hagamos el examen por la cara, o que te vayamos guiando? Si lo que necesitas es guía (espero que sea así), lo primero es asignar un código al botón "Mostrar Formulario" para que lo muestre ¿Cómo?... Con el botón derecho sobre el botón, en modo DISEÑO en la página Desarrollador o Programador (dependiendo de la versión de Excel), te crea directamente una Sub en la que tienes que poner el código para mostrar el formulario (¿Esto lo habrás estudiado, no?)

Qué tal @CECILIO Como no sé cuál es tu objetivo, no he hecho nada, pero deberías aclarar si lo que REALMENTE necesitas es la comparación que haces. Comparas la primera celda de h1 con TODAS las celdas de h2, luego la segunda celda de h1 con TODAS las celdas de h2 y así sucesivamente. Total que realizas, redondeando, 562500 comparaciones . No hay manera de optimizar esa macro si es lo que realmente necesitas. Lo que no puedes esperar es que Excel, en una comparación de casi 600000 celdas tarde poco. Excel VBA es bueno, pero milagros no puede hacer.

@josivox , aparte de que hay partes de tu código que no entiendo o no le encuentro sentido (seguramente porque no sé cómo funciona), creo que tu problema es que siempre trabajas con el ActiveWorkBook... Asegúrate de que cuando guardes, el ActiveWorkBook es el que quieres guardar y no el principal. Para eso usa el método que bien te dice @digitalboy , inspeccionando valores en la ventana inmediato. Siempre es bueno cunado surgen estos problemas empezar por depurar el código con puntos de interrupción, ventana inmediato, etc.

Madre mía @LeandroA ¡Cómo se me había pasado este aporte a mí! Mil gracias