Insertar parte del titulo del Archivo en 2 celdas
Tengo la macro
Sub exportando()_libroA.Activate_Range("B19").Select_Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _:=False, Transpose:=False_'Selection.PasteSpecial_Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False_'Application.CutCopyMode = False_ActiveSheet.Copy
'creamos un nuevo objeto Libro_Set wb = ActiveWorkbook_With wb_'guardamos el libro en la misma carpeta y cuyo nombre es la hoja copiada_EN ESTA LINIA NECESITARIA EJEMPLO: EL TITULO ES 1° 2° MAÑANA 2° LLAMADO_Que "1°" se copia en la celda "f13" y el otro "2°" en la celda "h13"del libro nuevo
YO TENGO LA FORMULA PARA SEPAR EL TEXTO QUE ES LA SIGUIENTE: =MED(celda donde se encuentre el texto;1;2) y se obtiene 1°_=MED(celda donde se encuentre el texto;3;2) y se obtiene 2°
.SaveAs miDire & "\" & nbreFilt & ".xlsx" ', FileFormat:=xlOpenXMLWorkbookMacroEnabled_'cerramos el nuevo libro_.Close_End With_'se libera el objeto_Set wb = Nothing_Range("B19:D43").ClearContents
Range("B19").Select_librox.Activate_End Sub
Podrán Ayudarme
2 Respuestas
Sí, puedo ayudarte. Puedes utilizar la función LEFT en lugar de MED para extraer el primer y segundo elemento del título del archivo. A continuación se muestra el código actualizado que incluye la inserción del título del archivo en dos celdas diferentes del nuevo libro:
Sub exportando()
' Copia la selección actual
LibroA. Activate
Range("B19").Select
Selection. Copy
VbnetCopy code
' Pega los valores en la nueva hoja de trabajo
ActiveSheet. Copy
Set wb = ActiveWorkbook
' Extrae los primeros dos elementos del título del archivo
Dim titulo As String
titulo = wb.Sheets(1).Name
Dim primerElemento As String
primerElemento = Left(titulo, 2)
Dim segundoElemento As String
segundoElemento = Left(Right(titulo, 4), 2)
' Inserta los elementos del título en dos celdas diferentes
wb.Sheets(1).Range("F13").Value = primerElemento
wb.Sheets(1).Range("H13").Value = segundoElemento
' Guarda el libro con el título de la hoja copiada
miDire = "C:\carpeta\"
nbreFilt = wb.Sheets(1).Name
wb.SaveAs miDire & nbreFilt & ".xlsx", FileFormat:=xlOpenXMLWorkbookMacroEnabled
wb.Close Set wb = Nothing
' Limpia el contenido de la selección original
Range("B19:D43").ClearContents
Range("B19").Select
librox.Activate
End Sub
Este código inserta el primer elemento del título en la celda F13 y el segundo elemento en la celda H13 del nuevo libro.
Tendrás que cambiar "C:\carpeta" a la ruta de la carpeta en la que deseas guardar el archivo.
Te dejo las instrucciones que necesitas agregar, marcadas en negrita, entre los siguientes mensajes:
'se cuenta la cant de filas resultantes
If finx > 11 Then
canti = Range(Cells(11, x), Cells(finx, x)). SpecialCells(xlCellTypeVisible). Count
'envia el nombre de la materia y del filtro
nbreMat = Cells(11, x)
anio = Left(crit, 2)
divi = Mid(crit, 3, 2)
Cells(11, x).Copy Destination:=libroA.Sheets(1).[C11]
libroA.[F13] = anio: libroA.[N13] = divi
'La variable guarda la ruta o directorio de la carpeta que buscamos
¡Gracias!
Fíjate que olvidé la hoja en lala última instrucción:
libroA.Sheets(1).[F13] = anio: libroA.Sheets(1).[N13] = divi
Ya sabemos que es la primer pestaña, si cambiás el orden deberás indicarle el nombre o su nuevo número.
Sdos!