Generar en el macro un libro nuevo en una carpeta específica y con un nombre específico
Soy nuevo en esto y necesito de su ayuda por favor.
Tengo mi macro creado pero necesito hacer lo siguiente:
1) Generar un libro nuevo en una carpeta específica con un nombre específico
2) Abrir el nuevo libro
3) Copiar una hoja específica ("BAI2) del libro origen hacia el libro destinto
4) Guardar la info que se ingreso al nuevo libro
5) Cerrar el nuevo libro
1 Respuesta
H o l a:
Pon la siguiente macro en tu libro origen.
Cambia en la macro la ruta y el nombre del archivo por tus datos, en estas líneas:
ruta = "C:\Trabajo\varios\"
arch = "nombre_arch"
La ruta debe terminar en diagonal "\"
Ejecuta la macro en tu libro origen, el cual debe tener la hoja llamada "BAI2".
Sub CopiarHoja()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ruta = "C:\Trabajo\varios\"
arch = "nombre_arch"
Sheets("BAI2").Copy
ActiveWorkbook.SaveAs ruta & arch
ActiveWorkbook.Close
MsgBox "Hoja copiada"
End Sub
Muchas gracias por responder.
Te detallo mas para que se entienda.
Necesito de las 6 hojas que tiene mi libro origen, copiar la hoja llamada "BAI2" en un nuevo excel, donde solo tendrá esa hoja llamada "BAI2", con eso que la guarde automáticamente.
Gracias por tu tiempo
Estaba guardando el archivo mediante ThisWorkbook.SaveAs ("Prueba2-" & Nrocuenta)
H o l a:
No entiendo qué es lo que necesitas.
Esto es lo que pediste:
"Copiar una hoja específica ("BAI2) del libro origen hacia el libro destinto"
¿Probaste la macro?
¿Qué le falta a la macro que te envié?
Disculpa, ya implemente tu código sin problemas. Me funciono a la perfección. Otra duda amigo si es que puedes. Si bien le asignamos un nombre al archivo (arch = "nombre_arch"), yo deseo que ese nombre sea según unas variables que tiene mi macro, ejemplo: folio - & Nrocuenta
en donde me mostrará algo así como 1-1020019719.xlsm
De dónde obtienes el folio y el Nrocuenta.
Prueba con esto:
folio = range("D2")
nrocuenta = range("E2")
arch = folio & "-" & nrocuentaTe puse un ejemplo, pues no sé de dónde obtienes los datos o cómo llenas las variables folio y nrocuenta.
Al final de mi respuesta hay un botón para valorar.
ThisWorkbook.Sheets("BAI2").Range("A1").Value = "01," & Cliente & "," & CodigoEjecutivo & "," & FechaActual & "," & HoraActual & "," & folio & ",,,2/"
Nrocuenta = Mid(Dato2, 5, 9)
folio = ThisWorkbook.Sheets("C2").Range("J1").Value
folio = folio + 1
Los obtengo a través de una cartola donde le asigne coordenadas para detectar el valor que quiero utilizar (en el caso de nrocuenta).
H o l a:
Nrocuenta = Mid(Dato2, 5, 9)
Para esto que pones necesitamos saber de dónde obtienes la variable Dato2.
Me estás dando la información en partes y así no puedo ayudarte.
Vamos a hacer lo siguiente, valora la respuesta y crea una nueva pregunta, en la nueva pregunta me explicas exactamente cómo tienes tu macro y de dónde obtengo la información para el nombre del archivo.
¡Gracias!
No creo merecer como calificación "Buena" mi respuesta, la macro hace lo que solicitaste, después estás solicitando otra cosa, pero no me estás dando las herramientas para ayudarte.
También te entregue esta parte:
folio = range("D2")
nrocuenta = range("E2")
arch = folio & "-" & nrocuentaLo que pudiste haber hecho es:
Sub CopiarHoja()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ruta = "C:\Trabajo\varios\"
'
Dato2 = "falta_saber_el_origen"
ThisWorkbook.Sheets("BAI2").Range("A1").Value = "01," & Cliente & "," & CodigoEjecutivo & "," & FechaActual & "," & HoraActual & "," & folio & ",,,2/"
Nrocuenta = Mid(Dato2, 5, 9)
folio = ThisWorkbook.Sheets("C2").Range("J1").Value
folio = folio + 1
'
arch = folio & "-" & Nrocuenta
Sheets("BAI2").Copy
ActiveWorkbook.SaveAs ruta & arch
ActiveWorkbook.Close
MsgBox "Hoja copiada"
End SubPero no me das la información completa, de esa forma no puedo ayudarte.
Dato2 = ThisWorkbook.Sheets("Cartola").Range("A2").Value
Nrocuenta = Mid(Dato2, 5, 9)
ThisWorkbook.Sheets("BAI2").Range("A3").Value = "03," & Nrocuenta & ",CLP" & ",015," & ConcatenaSaldoF & ",,," & "010," & ConcatenaSaldoI & ",,," & "100," & ConcatenaCargo & ",/"
Sigues sin poner la información completa y no puedo deducir el orden de las variables.
Pon tu macro completa.
O prueba con lo siguiente. La lógica es la siguiente, primero pasas los datos a tus variables
folio = ThisWorkbook.Sheets("C2").Range("J1").Value
folio = folio + 1
Dato2 = ThisWorkbook.Sheets("Cartola").Range("A2").Value
ThisWorkbook.Sheets("BAI2").Range("A1").Value = "01," & Cliente & "," & CodigoEjecutivo & "," & FechaActual & "," & HoraActual & "," & folio & ",,,2/"
Nrocuenta = Mid(Dato2, 5, 9)y luego pones el nombre de tu archivo:
arch = folio & "-" & Nrocuenta
La macro completa, prueba la macro.
Sub CopiarHoja()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ruta = "C:\Trabajo\varios\"
'
folio = ThisWorkbook.Sheets("C2").Range("J1").Value
folio = folio + 1
Dato2 = ThisWorkbook.Sheets("Cartola").Range("A2").Value
ThisWorkbook.Sheets("BAI2").Range("A1").Value = "01," & Cliente & "," & CodigoEjecutivo & "," & FechaActual & "," & HoraActual & "," & folio & ",,,2/"
Nrocuenta = Mid(Dato2, 5, 9)
'
arch = folio & "-" & Nrocuenta
Sheets("BAI2").Copy
ActiveWorkbook.SaveAs ruta & arch
ActiveWorkbook.Close
MsgBox "Hoja copiada"
End SubR ecuerda cambiar la valoración de la respuesta.
Private Sub CommandButton1_Click()
'1
Datos = ThisWorkbook.Sheets("Cartola").Range("A1").Value
ID = Mid(Datos, 1, 13)
Nombre = Mid(Datos, 14, 31)
FechaInicial = Mid(Datos, 52, 8)
FechaFinal = Mid(Datos, 60, 8)
SaldoInicial = Mid(Datos, 68, 16)
CodigoEjecutivo = Mid(Datos, 88, 9)
Iniciales = Mid(Nombre, 1, 5)
SaldoInicial2 = Mid(Datos, 69, 15)
For i = 1 To 1000
If ThisWorkbook.Sheets("Codigo").Cells(i, 1).Value = Nombre Then
Cliente = ThisWorkbook.Sheets("Codigo").Cells(i, 2).Value
i = 999
End If
Next i
folio = ThisWorkbook.Sheets("C2").Range("J1").Value
folio = folio + 1
Fecha = Date
FechaActual = Year(Fecha) - 2000 & Month(Fecha) & Day(Fecha)
Fecha = Now
'validacion hora con cero
Hora = Hour(Fecha)
Dim Test As String
Test = Len(Hora)
If Test < 2 Then
Hora = "0" & Hora
End If
HoraActual = Hora & Minute(Fecha)
ThisWorkbook.Sheets("BAI2").Range("A1").Value = "01," & Cliente & "," & CodigoEjecutivo & "," & FechaActual & "," & HoraActual & "," & folio & ",,,2/"
ThisWorkbook.Sheets("C2").Range("J1").Value = folio
'2
Fecha = Date
FechaActual = Year(Fecha) - 2000 & Month(Fecha) & Day(Fecha)
Fecha = Now
'validacion hora con cero
Hora = Hour(Fecha)
Test = Len(Hora)
If Test < 2 Then
Hora = "0" & Hora
End If
HoraActual = Hora & Minute(Fecha)
ThisWorkbook.Sheets("BAI2").Range("A2").Value = "02," & CodigoEjecutivo & "," & Cliente & "," & "1," & FechaActual & "," & HoraActual & ",CLP,/"
'Cuenta = ThisWorkbook.Sheets("Cartola").Range("D5").Value
'Cuenta = Replace(Cuenta, "-", "")
'16
i = 2
Dim contador As Integer
suma = 0
contador = 0
Do While ThisWorkbook.Sheets("Cartola").Cells(i, 1).Value <> ""
Dato = ThisWorkbook.Sheets("Cartola").Cells(i, 1).Value
Idd = Mid(Dato, 1, 13)
Fecha = Mid(Dato, 14, 8)
codigo = Mid(Dato, 24, 8)
Cargo = Mid(Dato, 34, 12)
SignoCargo = Mid(Dato, 32, 1)
Saldo = Mid(Dato, 49, 15)
Texto = Mid(Dato, 64, 25)
Codigo2 = Mid(Dato, 22, 2)
StrCod = CStr(Codigo2)
For j = 1 To 1000
If ThisWorkbook.Sheets("C2").Cells(j, 2).Value = StrCod Then
Reemplazo = ThisWorkbook.Sheets("C2").Cells(j, 7).Value
j = 999
End If
Next j
ThisWorkbook.Sheets("Bai2").Cells(i + 3, 1).Value = "16," & Reemplazo & "," & SignoCargo & Cargo & ",Z," & Texto & "," & codigo & ",/"
contador = contador + 1
' ThisWorkbook.Sheets("Bai2").Cells(i + 1, 3).Value = ThisWorkbook.Sheets("Cartola").Cells(i, 1).Value
i = i + 1
Loop
Ultimo = ThisWorkbook.Sheets("Cartola").Cells(contador + 1, 1).Value
Idulti = Mid(Ultimo, 1, 13)
Codigoraro = Mid(Ultimo, 14, 6)
Cargoult = Mid(Ultimo, 20, 16)
CargoU = Mid(Ultimo, 22, 14)
SignoU = Mid(Ultimo, 20, 1)
Cargoult3 = Mid(Ultimo, 20, 16)
Cargoult2 = Mid(Ultimo, 21, 15)
CodigoCargo = Mid(Ultimo, 36, 7)
Abono = Mid(Ultimo, 42, 16)
Abono2 = Mid(Ultimo, 43, 15)
AbonoF = Mid(Ultimo, 44, 14)
SignoA = Mid(Ultimo, 42, 1)
SaldoFinal = Mid(Ultimo, 58, 16)
SaldoFinal2 = Mid(Ultimo, 59, 15)
SaldoFinal3 = Mid(Ultimo, 64, 8)
'14 digitos y signo
SaldoF = Mid(Ultimo, 60, 14)
Signo = Mid(Ultimo, 58, 1)
'3
Dato3 = ThisWorkbook.Sheets("Cartola").Range("A1").Value
Dato2 = ThisWorkbook.Sheets("Cartola").Range("A2").Value
NroCuenta = Mid(Dato2, 5, 9)
SaldoIni = Mid(Dato3, 69, 16)
SaldoI = Mid(Dato3, 71, 14)
SignoI = Mid(Dato3, 69, 1)
SaldoIni3 = Mid(Dato3, 74, 9)
SaldoIni2 = Mid(Dato2, 49, 15)
'14 digitos + signo
Dim ConcatenaSaldoF As String
Dim ConcatenaSaldoI As String
Dim ConcatenaCargo As String
Dim ConcatenaAbono As String
ConcatenaSaldoF = Signo & SaldoF
ConcatenaSaldoI = SignoI & SaldoI
ConcatenaCargo = SignoU & CargoU
ConcatenaAbono = SignoA & AbonoF
ThisWorkbook.Sheets("BAI2").Range("A3").Value = "03," & NroCuenta & ",CLP" & ",015," & ConcatenaSaldoF & ",,," & "010," & ConcatenaSaldoI & ",,," & "100," & ConcatenaCargo & ",/"
'88
ThisWorkbook.Sheets("BAI2").Range("A4").Value = "88,,,400," & ConcatenaAbono & ",,,/"
'49
Dim CargoSuma As Long
Dim FinSuma As Double
Dim SaldoIniSuma As Double
Dim AbonoSuma As Double
CargoSuma = CDbl(Cargoult2)
FinSuma = CDbl(SaldoFinal3)
IniSuma = CDbl(SaldoIni3)
AbonoSuma = CDbl(Abono2)
Dim SumaFinal As Double
SumaFinal = (2 * CargoSuma) + FinSuma + IniSuma + (2 * AbonoSuma)
Dim Str As Double
digito = CStr(SumaFinal)
Sumaa = SumaFinal
Str = Len(digito)
k = 12 - Str
For i = 1 To k
Sumaa = "0" & Sumaa
Next i
'codigo = "123/5"
'codigo = String(12 - Len(codigo), "0") & codigo
ThisWorkbook.Sheets("BAI2").Cells(contador + 4, 1).Value = "49," & Sumaa & "," & contador + 1 & "/"
'98
ThisWorkbook.Sheets("BAI2").Cells(contador + 5, 1).Value = "98," & Sumaa & ",1," & contador + 2 & "/"
'99
ThisWorkbook.Sheets("BAI2").Cells(contador + 6, 1).Value = "99," & Sumaa & ",1," & contador + 3 & "/"
Dim arch As String
Ruta = "C:\Archivos\Excel\"
arch = folio & "-" & NroCuenta
End Sub
Sub CrearCarpeta()
CreaCarpeta "C:\", "Archivos"
End Sub
Sub CreaCarpeta(Ruta As String, NomCarpeta As String)
''Verificar si la carpeta existe.
If Dir(Ruta, vbDirectory + vbHidden) <> "" Then
''Comprueba que la carpeta no exista para crear el directorio.
If Dir(Ruta & "\" & NomCarpeta, vbDirectory + vbHidden) = "" Then _
MkDir Ruta & "\" & NomCarpeta
Shell ("cmd /c mkdir """ & "C:\Archivos\Excel\")
End If
End Sub
Sub CopiarHoja()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Ruta = "C:\Archivos\Excel\"
arch = (folio & "-" & NroCuenta)
Sheets("BAI2").Copy
ActiveWorkbook.SaveAs Ruta & arch
ActiveWorkbook.Close
MsgBox "Hoja copiada"
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub
Para seguir ayudándote, tienes que cambiar la valoración de la respuesta y crear un nueva pregunta para revisar tu macro.
Disculpa que no entienda mucho, he seguido tus pasos pero no me detecta las variables para que me ingrese el nombre deseado en el archivo
Ahora menos puedo ayudarte, quitaste la valoración de mi respuesta.
La macro que te envié realiza lo que solicitaste, lo que ahora pides corresponde a otra petición.
Lo único que se les pide a cambio de la ayuda es que valoren las respuestas, pero si no valoras la ayuda que te estoy brindando, entonces ya no te puedo ayudar.
Vaya forma de agradecer.
amigo, me confundes, te valore, después me dices que lo saque.
En fin volví a valorarte, fue un malentendido
Gracias por tu ayuda, te lo agradezco sinceramente
Que tengas un buen día
Disculpa entonces si fue un malentendido.
