Macro para renombrar archivos excel
Quiero saber si con una macro puedo cambiar de nombres a varios libros excel.
Explico lo que hago manualmente:
Paso 1:
-Tengo estos libros excel, identificado con un numero de correlativo. (Como se muestra en la foto)
Paso 2:
Luego tengo un libro excel donde cada numero de correlativo tiene un numero de factura asociada, hago lo siguiente: Por ejemplo la entrega 1529362910 tiene una numero de factura, copio ese numero, me voy a la carpeta donde tengo guardado los archivos, ubico la entrega (1529362910), selecciono con F2 y reemplazo el nombre por el numero de factura, a la ves abro el libro excel y vuelvo a copiar la misma factura en la celda B8 (siempre sera en esa dirección de celda), luego cierro ese libro, y comienzo a hacer el mismo proceso para los libros siguientes
En la foto adjunta:
-La parte izquierda es el libro con mi factura asociada, luego la imagen de la entrega 1529362910 y como la reemplazo con el numero factura, por ultimo copiar en B8 el mismo numero.
Quisiera saber si una macro puede hacer esta lectura e ir cambiando los nombres por la factura.
A la espera de su aporte.
1 Respuesta
Te anexo la macro
Sub RenombrarArchivos()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'
Set l1 = ThisWorkbook
Set h1 = l1.Sheets(1)
'
ruta = l1.Path & "\"
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
arch = h1.Cells(i, "A") & ".xlsx"
arc2 = h1.Cells(i, "B") & ".xlsx"
If Dir(ruta & arch) = "" Then
h1.Cells(i, "C") = "No existe archivo"
Else
Set l2 = Workbooks.Open(ruta & arch)
l2.Sheets(1).[B8] = h1.Cells(i, "B")
l2.Close True
Name ruta & arch As ruta & arc2
h1.Cells(i, "C") = "Archivo renombrado"
End If
Next
MsgBox "Terminado"
End SubS a l u d o s . D a n t e A m o r
Recuerda valorar la respuesta.
Hola Date:
Los libros excel son 97-2003 como le cambio la extensión para que pueda renombrarlos??
En esta parte cambia xlsx por xls
arch = h1.Cells(i, "A") & ".xlsx" arc2 = h1.Cells(i, "B") & ".xlsx"
