1.b.- En esta Hoja “CUENTAS”tengo las Cuentas Contable. 2 Columnas
Código(6digitos)/Cuenta Contable(Nombre)
CODIGO
CUENTA
110102
CAJA GENERAL
110201
BANCOS BICENTENARIO
110202
BANCOS SOFITASA
110203
BANCO PLAZA
Lo que hace el archivo es mediante un Combox (cmb_lista), tomo las cuentas contable de la hoja(Cuentas) y filtro la información de la hoja(Profit), lo muestra en un Listbox(Listbox1) y mediante un botón llamado “Generar Analisis”, envio esa información al Archivo2 (Mayor), que esta cerrado y protegido (con clave:1234) en un carpeta designada con una subcarpeta (Esto lo he logrado con ayudas en el foro (Ultima Ayuda Haplox), cumple 2 condiciones
a.- No existe el Analisis (Hoja con nombre de la cuenta) el archivo crea la hoja y copia lo que filtro el Listbox.
b.-Si existe la hoja el código selecciona la hoja y Copia la información del Listbox en la ultima línea de la información.
La Data de la Hoja PROFIT, debo actualizarla mensualmente por lo que debere filtrar mes a mes.
Public Sub TransferirANalisisSinMSGBOX()
Dim nombrehoja
Application.ScreenUpdating = False
abrirRuta
On Error Resume Next
With Frm_FiltrarCta
nombrehoja = .LblNomCta.Caption
If ActiveSheet.Name <> .LblNomCta.Caption Then
Windows("mayor.XLSX").Activate
ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Select
ActiveSheet.Name = nombrehoja
'Titulo Analisis
TituloFormat
ActiveWorkbook.Sheets(nombrehoja).Cells(7, 2) = "Info"
ActiveWorkbook.Sheets(nombrehoja).Cells(4, 3) = .Cmb_Lista.Text
ActiveWorkbook.Sheets(nombrehoja).Cells(4, 4) = .LblNomCta
ActiveWorkbook.Sheets(nombrehoja).Cells(8, 2) = .Lbl_Contar
ActiveWorkbook.Sheets(nombrehoja).Cells(1, 2) = "ª"
ActiveWorkbook.Sheets(nombrehoja).Cells(3, 2) = "ª"
ActiveWorkbook.Sheets(nombrehoja).Cells(4, 2) = "ª"
ActiveWorkbook.Sheets(nombrehoja).Cells(5, 2) = "ª"
ActiveWorkbook.Sheets(nombrehoja).Cells(6, 2) = "ª"
Final = GetNuevoR(ActiveWorkbook.Sheets(nombrehoja)) + 6
For i = 0 To .ListBox1.ListCount - 1
xCodigo = .ListBox1.List(i, 0) 'Cantidad
xFecha = .ListBox1.List(i, 1) 'Código de Producto
xReferencia = .ListBox1.List(i, 2) 'Nombre del Producto o Descripción
xDescripcion = .ListBox1.List(i, 3) 'Precio Venta
xMonto = .ListBox1.List(i, 4) 'Importe
ActiveWorkbook.Sheets(nombrehoja).Cells(Final, 2) = xCodigo
ActiveWorkbook.Sheets(nombrehoja).Cells(Final, 3) = xFecha
ActiveWorkbook.Sheets(nombrehoja).Cells(Final, 4) = xReferencia
ActiveWorkbook.Sheets(nombrehoja).Cells(Final, 5) = xDescripcion
ActiveWorkbook.Sheets(nombrehoja).Cells(Final, 6) = Val(xMonto)
Final = Final + 1
Next
Range("B7").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.AutoFormat Format:=xlRangeAutoFormatList1, Number:=True, Font:= _
True, Alignment:=True, Border:=True, Pattern:=True, Width:=True
Else
'Copiar el listbox en el archivo Mayor
'ActiveWorkbook.Sheets(nombrehoja).Range("B" & Sheets(nombrehoja).Rows.Count).End(xlUp).Offset(1, 0).Select
Final = GetNuevoRCopiar(Sheets(nombrehoja))
For i = 0 To .ListBox1.ListCount - 1
xCodigo = .ListBox1.List(i, 0) 'Cantidad
xFecha = .ListBox1.List(i, 1) 'Código de Producto
xReferencia = .ListBox1.List(i, 2) 'Nombre del Producto o Descripción
xDescripcion = .ListBox1.List(i, 3) 'Precio Venta
xMonto = .ListBox1.List(i, 4) 'Importe
ActiveWorkbook.Sheets(nombrehoja).Cells(Final, 2) = xCodigo
ActiveWorkbook.Sheets(nombrehoja).Cells(Final, 3) = xFecha
ActiveWorkbook.Sheets(nombrehoja).Cells(Final, 4) = xReferencia
ActiveWorkbook.Sheets(nombrehoja).Cells(Final, 5) = xDescripcion
ActiveWorkbook.Sheets(nombrehoja).Cells(Final, 6) = Format(xMonto, "#,##0.00")
Final = Final + 1
Next
End If
End With
Windows("Mayor.xlsm").Activate
Windows("Mayor.xlsx").Close True
Windows("Filtros Archivo.xlsm").Activate
End Sub
Que es lo que requeria… con el código TransferirAnalisisSinMsgbox hace el procedimiento 1 a 1, cada cuenta que selecciono, Su valiosa ayuda aquí…adaptar este código para que se genere en forma repetida por cada una de las cuentas que están en el Listbox1(Hoja Cuentas).
Esto con la finalidad de 1- poder generar como una especie de corrida de cuentas(su ayuda) y 2.- si deseo generar cuentas especificas(la macro TransferirAnalisisSinMsgbox), agregando un botón para separar la 2 formas de generar los análisis.
Es importante recalcar que en el hojas “cuentas” están todas las cuentas que existen son 167,pero la hoja Data, esta la información del mes por lo que habría la posibilidad de que en un mes existan cuenta que no tengan data en la Hoja “Profit”.
De verdad toda la ayuda que puedan prestarme... Muchas Gracias
Hola Amigos del Foro
Recurro a su valiosa ayuda para avanzar en un archivo que he venido adaptando para una automatización que requiero.
Tengo 2 Archivos
1.-Filtro Archivo.xlsm
2.-Mayor.xlsx
El archivo 1.-Filtro Archivo.xlsm tiene 2 Hojas
1.a.- En esta hoja “PROFIT” esta la data de la información a filtrar en 5 columnas
Código/Fecha/Referencia/Descripción/saldo
1.b.- En esta Hoja “CUENTAS”tengo las Cuentas Contable. 2 Columnas
Código(6digitos)/Cuenta Contable(Nombre)
Lo que hace el archivo es mediante un Combox (cmb_lista), tomo las cuentas contable de la hoja(Cuentas) y filtro la información de la hoja(Profit), lo muestra en un Listbox(Listbox1) y mediante un botón llamado “Generar Analisis”, envio esa información al Archivo2 (Mayor), que esta cerrado y protegido (con clave:1234) en un carpeta designada con una subcarpeta (Esto lo he logrado con ayudas en el foro (Ultima Ayuda Haplox), cumple 2 condiciones
a.- No existe el Analisis (Hoja con nombre de la cuenta) el archivo crea la hoja y copia lo que filtro el Listbox.
b.-Si existe la hoja el código selecciona la hoja y Copia la información del Listbox en la ultima línea de la información.
La Data de la Hoja PROFIT, debo actualizarla mensualmente por lo que debere filtrar mes a mes.
Public Sub TransferirANalisisSinMSGBOX() Dim nombrehoja Application.ScreenUpdating = False abrirRuta On Error Resume Next With Frm_FiltrarCta nombrehoja = .LblNomCta.Caption If ActiveSheet.Name <> .LblNomCta.Caption Then Windows("mayor.XLSX").Activate ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count) ActiveSheet.Select ActiveSheet.Name = nombrehoja 'Titulo Analisis TituloFormat ActiveWorkbook.Sheets(nombrehoja).Cells(7, 2) = "Info" ActiveWorkbook.Sheets(nombrehoja).Cells(4, 3) = .Cmb_Lista.Text ActiveWorkbook.Sheets(nombrehoja).Cells(4, 4) = .LblNomCta ActiveWorkbook.Sheets(nombrehoja).Cells(8, 2) = .Lbl_Contar ActiveWorkbook.Sheets(nombrehoja).Cells(1, 2) = "ª" ActiveWorkbook.Sheets(nombrehoja).Cells(3, 2) = "ª" ActiveWorkbook.Sheets(nombrehoja).Cells(4, 2) = "ª" ActiveWorkbook.Sheets(nombrehoja).Cells(5, 2) = "ª" ActiveWorkbook.Sheets(nombrehoja).Cells(6, 2) = "ª" Final = GetNuevoR(ActiveWorkbook.Sheets(nombrehoja)) + 6 For i = 0 To .ListBox1.ListCount - 1 xCodigo = .ListBox1.List(i, 0) 'Cantidad xFecha = .ListBox1.List(i, 1) 'Código de Producto xReferencia = .ListBox1.List(i, 2) 'Nombre del Producto o Descripción xDescripcion = .ListBox1.List(i, 3) 'Precio Venta xMonto = .ListBox1.List(i, 4) 'Importe ActiveWorkbook.Sheets(nombrehoja).Cells(Final, 2) = xCodigo ActiveWorkbook.Sheets(nombrehoja).Cells(Final, 3) = xFecha ActiveWorkbook.Sheets(nombrehoja).Cells(Final, 4) = xReferencia ActiveWorkbook.Sheets(nombrehoja).Cells(Final, 5) = xDescripcion ActiveWorkbook.Sheets(nombrehoja).Cells(Final, 6) = Val(xMonto) Final = Final + 1 Next Range("B7").Select Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select Selection.AutoFormat Format:=xlRangeAutoFormatList1, Number:=True, Font:= _ True, Alignment:=True, Border:=True, Pattern:=True, Width:=True Else 'Copiar el listbox en el archivo Mayor 'ActiveWorkbook.Sheets(nombrehoja).Range("B" & Sheets(nombrehoja).Rows.Count).End(xlUp).Offset(1, 0).Select Final = GetNuevoRCopiar(Sheets(nombrehoja)) For i = 0 To .ListBox1.ListCount - 1 xCodigo = .ListBox1.List(i, 0) 'Cantidad xFecha = .ListBox1.List(i, 1) 'Código de Producto xReferencia = .ListBox1.List(i, 2) 'Nombre del Producto o Descripción xDescripcion = .ListBox1.List(i, 3) 'Precio Venta xMonto = .ListBox1.List(i, 4) 'Importe ActiveWorkbook.Sheets(nombrehoja).Cells(Final, 2) = xCodigo ActiveWorkbook.Sheets(nombrehoja).Cells(Final, 3) = xFecha ActiveWorkbook.Sheets(nombrehoja).Cells(Final, 4) = xReferencia ActiveWorkbook.Sheets(nombrehoja).Cells(Final, 5) = xDescripcion ActiveWorkbook.Sheets(nombrehoja).Cells(Final, 6) = Format(xMonto, "#,##0.00") Final = Final + 1 Next End If End With Windows("Mayor.xlsm").Activate Windows("Mayor.xlsx").Close True Windows("Filtros Archivo.xlsm").Activate End Sub
Que es lo que requeria… con el código TransferirAnalisisSinMsgbox hace el procedimiento 1 a 1, cada cuenta que selecciono, Su valiosa ayuda aquí… adaptar este código para que se genere en forma repetida por cada una de las cuentas que están en el Listbox1(Hoja Cuentas).
Esto con la finalidad de 1- poder generar como una especie de corrida de cuentas(su ayuda) y 2.- si deseo generar cuentas especificas(la macro TransferirAnalisisSinMsgbox), agregando un botón para separar la 2 formas de generar los análisis.
Es importante recalcar que en el hojas “cuentas” están todas las cuentas que existen son 167, pero la hoja Data, esta la información del mes por lo que habría la posibilidad de que en un mes existan cuenta que no tengan data en la Hoja “Profit”.
De verdad toda la ayuda que puedan prestarme... Muchas Gracias
Mayor.rar