Procedimmiento demasiado largo en vba, me aparece ese error no se como dividir los código para que funcionen

Tengo ese código que es dos veces más grande y cuando intento abrir mi userform me da el error Procedimmiento demasiado largo

5 respuestas

Respuesta
3

Te anexo un ejemplo utilizando un SOLO procedimiento para cada uno de tus bloques:

Private Sub CommandButton211_Click()
    If OptionButton5 = True Then
        'kabelmenge M1
        Call Pasar_A_Hoja("zusammenfassung", "B", 41, 51, 110)
        '
        'me kabeltecsum
        Call Pasar_A_Hoja("zusammenfassung", "C", 41, 51, 121)
        '
        'stecker-buchsetecsum
        Call Pasar_A_Hoja("zusammenfassung", "D", 41, 51, 132)
        '
        'stecker-buchsetecsum
        Call Pasar_A_Hoja("zusammenfassung", "E", 41, 51, 143)
        '
        'etc
    End If
End Sub
'
Sub Pasar_A_Hoja(hoja, col, fini, ffin, n)
    For i = fini To ffin
        Sheets(hoja).Range(col & i).Value = Val(Me.Controls("TextBox" & n))
        n = n + 1
    Next
End Sub

'.[Sal u dos. Dante Amor.

Saludos Dante!

he puesto el siguiente codigo, para el primerif y no me funciona

If OptionButton5 = True Then
'kabelmenge M1
Call Pasar_A_Hoja("zusammenfassung", "B", 41, 51, 110)
'
'me kabeltecsum
Call Pasar_A_Hoja("zusammenfassung", "C", 41, 51, 121)
'
'stecker-buchsetecsum
Call Pasar_A_Hoja("zusammenfassung", "D", 41, 51, 132)
'
'ME stecker-buchsetecsum
Call Pasar_A_Hoja("zusammenfassung", "E", 41, 51, 143)
'SICHERUNGEN
Call Pasar_A_Hoja("zusammenfassung", "F", 41, 51, 800)
'ME SICHERUNGEN
Call Pasar_A_Hoja("zusammenfassung", "G", 41, 51, 154)
'SIHAPR
Call Pasar_A_Hoja("zusammenfassung", "H", 41, 51, 165)
'SIHACR ME
Call Pasar_A_Hoja("zusammenfassung", "F", 41, 51, 187)
'SIHACR
Call Pasar_A_Hoja("zusammenfassung", "G", 41, 51, 198)

Call Pasar_A_Hoja("zusammenfassung", "F", 41, 51, 209)
'ME SICHERUNGEN
Call Pasar_A_Hoja("zusammenfassung", "G", 41, 51, 220)
'SIHAPR
Call Pasar_A_Hoja("zusammenfassung", "H", 41, 51, 232)
'SIHACR ME
Call Pasar_A_Hoja("zusammenfassung", "F", 41, 51, 254)
'SIHACR
Call Pasar_A_Hoja("zusammenfassung", "G", 41, 51, 264)
'
'etc
End If
End Sub
'
Sub Pasar_A_Hoja(hoja, col, fini, ffin, n)
For i = fini To ffin
Sheets(hoja).Range(col & i).Value = Val(Me.Controls("TextBox" & n))
n = n + 1
Next
End Sub

¿Y qué hace o qué no hace?

¿Te envía algún error?

Prueba con una sola línea

Call Pasar_A_Hoja("zusammenfassung", "B", 41, 51, 110)

Y después vas incrementando las líneas

no hace nada

Tienes que tener valores en los textbox110 al textbox121, el optionbutton5 debe estar seleccionado, ¿ejecuta en debug la prueba y dime qué hace?

Me da el siguiente error, pero yo no tengo que tener todos textbox con vaolres algunos quedan vacío.. Me dice que no encuentra el objeto. He sustituido la hoja por zusammenfassung y sigue el error he quitado las comillas como tú de hoja y también sigue el error

Gracias

Eusebio

Esto puse en mi respuesta:

        Sheets(hoja).Range(col & i).Value = Val(Me.Controls("TextBox" & n))

Y tú estás poniendo la palabra "hoja" entre comillas. Borra las comillas

Sheets("hoja")

Yo la he probado también sin comilla y me dice que no encuentra el objeto

Eusebio

Otra cosa que debes cuidar es que los textbox deben existir.

Si ejecutas la rutina por ejemplo:

Call Pasar_A_Hoja("zusammenfassung", "B", 41, 51, 110)

Significa que los textbox empiezan en textbox110 y terminan en el textbox120

Entonces también debe revisar que existan los textbox 110 al textbox120, así para cada uno de tus llamadas.

¡Gracias!

Un millón de Gracias, era mi error. Todo funciona correctamente

Gracias nuevamente

Saludos

Eusebio

Ya esa me funciona pero en la misma userform tengo textbox que van de la celda 21 a la 31 y se deben positionar con otro botón click. He echo exactamente igual al proceso anterior y me error, he comprobado los textbox y todo esta correcto, he cambiado hoja por hoja por hoja1 y me error y no se por que ahí te envío lo que he echo así como el ejemplo. La parte de abajo esta terminada que es la más grande . La parte superior que debe ser igual lo que en otro rnago y con otro botón me da error

Gracias por tu gran ayuda

Eusebio

¿Cuál de las llamadas es la que tiene problemas?

La de arriba es decir desde b21: z31

De todas forma la grande me funciona perfectamente es decir la de abajo con las indicaciones que me diste.

Gracias 

Eusebio 

No te entiendo, todas las líneas dicen 21 a 31

Tiene problemas para entender este concepto

Call Pasar_A_Hoja("zusammenfassung", "B", 41, 51, 110)

¡Gracias! Si entiendo lo que me me has enviado. Pero lo que sucede es que estoy en el mismo userform pero con otros textbox que deben descargar sus datos en la misma hoja de excel pero en otra region es  decir b11:z31 con el mismo procedimiento al que me enviaste. Que sucede? Pues cuando pongo hoja al hacer salvar( o speichern)entonces me lleva a un error en la correcta, Por eso cambue a hoja1 asi se elimina el error abajo, pero aparece arriba como re he enviado.  Es decir que cuando coloco los dos vodigos me da error

Disculpa tanto momentan

Buenas noche

Eusebio 

Respuesta
2

Mi amigo te tengo la solución. Ya sabemos que el problema de tu macro es por que esta muy larga, además como te consume mucha memoria en Excel, tu macro se estará cerrando por falta de Memoria o Saturación de la misma, lo que tienes que hacer es pedirle a Windows que te brinde apoyo mediante una función llamada "DOEVENTS" el nombre de esta función debes añadirla al final de tu código por ejemplo:

Sub Mi_Macro()
'Aqui tu codigo
'La función DoEvents al Final
DoEvents
End Sub

¡Gracias! 

Me da gusto que te halla servido

Respuesta
2

Todo tu procedimiento puede ser reducido a unas cuantas líneas ve la imagen de una modificación que hice a tu macro, más abajo esta el código

y esta es la macro, lo único que tienes que hacer es cambiar el nombre de la hoja destino y esta macro cubre un área comprendida entre la columna b41 y la Z51, si quieres más columnas modifica la primera línea, para la captura de datos es sobre 4 columnas si quieres más solo copia la línea .cells(i, 4)=userform1.control("textbox1") & 1 +33) y cambiala por .cells(i,5)=userform1.control("textbox1") & 1 +44) y asi sucesivamente.

Private Sub CommandButton1_Click()
Set datos = Worksheets("hoja1").Range("b41:z51")
With datos
    filas = .Rows.Count
    For i = 1 To filas
        .Cells(i, 1) = UserForm1.Controls("textbox" & i)
        .Cells(i, 2) = UserForm1.Controls("textbox" & i + 11)
        .Cells(i, 3) = UserForm1.Controls("textbox" & i + 22)
        .Cells(i, 4) = UserForm1.Controls("textbox" & i + 33)
    Next i
End With
set datos=nothing
End Sub

¡Gracias! 

Saludos Jame, 

he seguido tus pasos y me da el siguiente error

Sin ver el mensaje de error que te pone pueden ser mil cosas, nombre mal escrito, que la hoja no exista o que este de algún modo protegida, que datos exista en algún otro lado como variable o nombre de procedimiento o función por mencionar las principales, ya probé la instrucción haciendo que pinte de amarillo el rango en cuestión y aquí tengo solo un comentario que el rango a usar no era b41:¿Z51?, eso te va marcar error también a la hora de la captura en la hoja

D

ime si vez algo extraño en esto, pues no me funciona:

Private Sub CommandButton211_Click()

Set datos = Worksheets("Zusammenfassung").Range("b41:z51")
With datos
filas = .Rows.Count
For i = 1 To filas
.Cells(i, 1) = FRM_Multiprojek.Controls("textbox" & i)
.Cells(i, 2) = FRM_Multiprojek.Controls("textbox" & i + 11)
.Cells(i, 3) = FRM_Multiprojek.Controls("textbox" & i + 22)
.Cells(i, 4) = FRM_Multiprojek.Controls("textbox" & i + 33)
Next i
End With
Set datos = Nothing
End Sub

Para no estar adivinando o suponiendo que ¿no seria más fácil que subieras un ejemplo en archivo Excel a google drive o media fire y pegas el enlace aquí?, los datos no tienen que ser reales solo la estructura de tu información es la que necesito ver.

Ok deja ver si me acuerdo como compartirlo.

Eusebio

Ya la he puesto freí en mi onedrive, ¿qué te hace falta para que la puedas ver?

Eusebio

https://1drv.ms/x/s!AjMSpDtE3sqxwkKEal287T6R15yD 

5121 lineas de codigo !, woooow !, yo que programado sistemas para jugar a la loteria con miles de calculos complejos o sistemas para optimizar cortes de barras lo mas que me llevado son 1000 lineas repartidas en modulos !, este tipo de programacion que estas usando es demasiado ineficiente y solucionar cualquier error que se presente no es nada facil, la mayoria de la lineas son de limpieza y otras para llenar datos que curiosamente se repiten en varios modulos, en fin

De entrada el programa me marca 2 errores en e modulo initialize en las lineas say que estan mal por 2 razones

1 le estas diciendo que abarque toda la columna I o todas las columnas de la j:IJ, y luego quieres que te lo cargue a un combobox2, aqui tienes que ser mas especifico tienes como varias tablas que tambien entraran en el combobox, estoy suponiendo que lo unico que qiores es lo que esta en el cuadro amarillo.

2.- Cuando tienes celdas combinadas en el rango que definiste la formula que pusiste no sabe como considerarla y te marca error.

Explicame ¿qué quieres hacer con estas lineas?.

Saludos Jame, el único error que tengo es que cuando aprieto el optionbutton de 1-8 y aprieto speichern (el de abjao)me dice que el programa es muy grande, pero por lo demás todo funciona perfecto, es decir prueba y selecciona el boto 1-5 luego carga lol que hay en el combobox o simplemente aprieta el botón speichern y veras el error

Un saludo

Eusebio

Entonces tienes otro problema que que el actual problema no te ha dejado ver, cada que intento correr tu formulario pasa lo que ves en las imágenes, me manda el error que veras en amarillo en la imagen de más abajo y de hay no avanzo, no se puede probar el botón del formulario si este no quiere mostrarse.

Si quieres puedes borrar todo lo relacionado con say, deja solo

Me.combobox.visible= false

Eso que esta ahí no es importante

Saludos

Eusebio

el modulo que indicas te marca error tiene 1411 lineas, muy largo en efecto pero antes de continuar te informo que la hoja en al que tienes la informacion esta corrupta o dañada por lo siguiente no acepta borrar informacion con la instruccion clearcontents ni clear tambien me muestra errores cuando ejecuto instrucciones como Set rango=range("b41:51") o hoja=activesheet.name, (error 32908) se comporta como si tuviera proteccion la hoja investigando un poco me decian que podia ser por las versiones de Excel pero como tu has pedido ayuda por los mismos problemas descarte eso y lo que hice fue copiar toda la informacion a un nuevo libro, el formulario lo exporte a un directorio y posteriormente lo importe de nuevo y los errores se acabaron y ya pude ver que pasaba con tu codigo, el cual reduci a 110 lineas, ya debe funcionar pero primero te aconsejo que hagas lo que ya te comente antes de correr la macro, y por cierto apagar y prender por cada modulo es muy ineficiente y una perdida de tiempo ponlo una sola vez en el initialize y luego en el evento terminate colocas la instruccion para prender de nuevo las opciones.

Private Sub CommandButton211_Click()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Set h1 = Worksheets("zusammenfassung")
Set rango = h1.Range("b41:z51")
If OptionButton5 = True Then
'Kabelmenge TECSUM M1
Set rango = h1.Range("b41:z51")
With rango
    r = .Rows.Count: c = .Columns.Count
    For i = 1 To r
        For j = 1 To c
            .Cells(i, 1) = FRM_Multiprojek.Controls("textbox" & 109 + i)
            .Cells(i, 2) = FRM_Multiprojek.Controls("textbox" & 120 + i)
            .Cells(i, 3) = FRM_Multiprojek.Controls("textbox" & 131 + i)
            .Cells(i, 4) = FRM_Multiprojek.Controls("textbox" & 142 + i)
            .Cells(i, 5) = FRM_Multiprojek.Controls("textbox" & 399 + i)
            .Cells(i, 6) = FRM_Multiprojek.Controls("textbox" & 799 + i)
            .Cells(i, 7) = FRM_Multiprojek.Controls("textbox" & 153 + i)
            .Cells(i, 8) = FRM_Multiprojek.Controls("textbox" & 164 + i)
            .Cells(i, 9) = FRM_Multiprojek.Controls("textbox" & 175 + i)
            .Cells(i, 10) = FRM_Multiprojek.Controls("textbox" & 186 + i)
            .Cells(i, 11) = FRM_Multiprojek.Controls("textbox" & 196 + i)
            .Cells(i, 12) = FRM_Multiprojek.Controls("textbox" & 208 + i)
            .Cells(i, 13) = FRM_Multiprojek.Controls("textbox" & 219 + i)
            .Cells(i, 14) = FRM_Multiprojek.Controls("textbox" & 231 + i)
            .Cells(i, 15) = FRM_Multiprojek.Controls("textbox" & 253 + i)
        Next j
    Next i
End With
ElseIf OptionButton6 = True Then
Set rango = h1.Range("u41:ak51")
With rango
    r = .Rows.Count: c = .Columns.Count
    For i = 1 To r
        For j = 1 To c
            .Cells(i, 18) = FRM_Multiprojek.Controls("textbox" & 109 + i)
            .Cells(i, 19) = FRM_Multiprojek.Controls("textbox" & 120 + i)
            .Cells(i, 20) = FRM_Multiprojek.Controls("textbox" & 131 + i)
            .Cells(i, 21) = FRM_Multiprojek.Controls("textbox" & 142 + i)
            .Cells(i, 22) = FRM_Multiprojek.Controls("textbox" & 399 + i)
            .Cells(i, 23) = FRM_Multiprojek.Controls("textbox" & 799 + i)
            .Cells(i, 24) = FRM_Multiprojek.Controls("textbox" & 153 + i)
            .Cells(i, 25) = FRM_Multiprojek.Controls("textbox" & 164 + i)
            .Cells(i, 25) = FRM_Multiprojek.Controls("textbox" & 175 + i)
            .Cells(i, 26) = FRM_Multiprojek.Controls("textbox" & 186 + i)
            .Cells(i, 27) = FRM_Multiprojek.Controls("textbox" & 196 + i)
            .Cells(i, 28) = FRM_Multiprojek.Controls("textbox" & 208 + i)
            .Cells(i, 29) = FRM_Multiprojek.Controls("textbox" & 219 + i)
            .Cells(i, 30) = FRM_Multiprojek.Controls("textbox" & 231 + i)
            .Cells(i, 31) = FRM_Multiprojek.Controls("textbox" & 253 + i)
        Next j
    Next i
End With
ElseIf OptionButton7 = True Then
Set rango = h1.Range("an41:bd51")
With rango
    r = .Rows.Count: c = .Columns.Count
    For i = 1 To r
        For j = 1 To c
            .Cells(i, 18) = FRM_Multiprojek.Controls("textbox" & 109 + i)
            .Cells(i, 19) = FRM_Multiprojek.Controls("textbox" & 120 + i)
            .Cells(i, 20) = FRM_Multiprojek.Controls("textbox" & 131 + i)
            .Cells(i, 21) = FRM_Multiprojek.Controls("textbox" & 142 + i)
            .Cells(i, 22) = FRM_Multiprojek.Controls("textbox" & 399 + i)
            .Cells(i, 23) = FRM_Multiprojek.Controls("textbox" & 799 + i)
            .Cells(i, 24) = FRM_Multiprojek.Controls("textbox" & 153 + i)
            .Cells(i, 25) = FRM_Multiprojek.Controls("textbox" & 164 + i)
            .Cells(i, 25) = FRM_Multiprojek.Controls("textbox" & 175 + i)
            .Cells(i, 26) = FRM_Multiprojek.Controls("textbox" & 186 + i)
            .Cells(i, 27) = FRM_Multiprojek.Controls("textbox" & 196 + i)
            .Cells(i, 28) = FRM_Multiprojek.Controls("textbox" & 208 + i)
            .Cells(i, 29) = FRM_Multiprojek.Controls("textbox" & 219 + i)
            .Cells(i, 30) = FRM_Multiprojek.Controls("textbox" & 231 + i)
            .Cells(i, 31) = FRM_Multiprojek.Controls("textbox" & 253 + i)
        Next j
    Next i
End With
ElseIf OptionButton8 = True Then
Set rango = h1.Range("bg41:bw51")
With rango
    r = .Rows.Count: c = .Columns.Count
    For i = 1 To r
        For j = 1 To c
            .Cells(i, 18) = FRM_Multiprojek.Controls("textbox" & 109 + i)
            .Cells(i, 19) = FRM_Multiprojek.Controls("textbox" & 120 + i)
            .Cells(i, 20) = FRM_Multiprojek.Controls("textbox" & 131 + i)
            .Cells(i, 21) = FRM_Multiprojek.Controls("textbox" & 142 + i)
            .Cells(i, 22) = FRM_Multiprojek.Controls("textbox" & 399 + i)
            .Cells(i, 23) = FRM_Multiprojek.Controls("textbox" & 799 + i)
            .Cells(i, 24) = FRM_Multiprojek.Controls("textbox" & 153 + i)
            .Cells(i, 25) = FRM_Multiprojek.Controls("textbox" & 164 + i)
            .Cells(i, 25) = FRM_Multiprojek.Controls("textbox" & 175 + i)
            .Cells(i, 26) = FRM_Multiprojek.Controls("textbox" & 186 + i)
            .Cells(i, 27) = FRM_Multiprojek.Controls("textbox" & 197 + i)
            .Cells(i, 28) = FRM_Multiprojek.Controls("textbox" & 208 + i)
            .Cells(i, 29) = FRM_Multiprojek.Controls("textbox" & 219 + i)
            .Cells(i, 30) = FRM_Multiprojek.Controls("textbox" & 231 + i)
            .Cells(i, 31) = FRM_Multiprojek.Controls("textbox" & 253 + i)
        Next j
    Next i
End With
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.CutCopyMode = False

Buenos días Jame, nuevamente muchísimas gracias por tú gentileza en dedicar de tu tiempo libre en esta tarea. Yo no soy programador y todo lo que hago es buscando aquí, buscando aya y preguntándole a ustedes.

Seria tan gentil y compartir el archivo que hiciste con mis datos, incluyendo lo que me dijiste del useform Inizialice y terminate, pues he copiado tú código y cuando aprieto speicher no sale nada.

Gracias

Eusebio

De hecho hay un error en lo que te mande no se que hice que la codificación que subí esta incompleta, le falto a las instrucciones el .text sin esa parte el código no hace nada, respecto a lo otro terminate, initialize yo a esa parte del código no le he movido nada solo expresaba una sugerencia de mover las application. Screenupdating y todas esas funciones las de apagar a initialize y las de prender al terminate así te ahorrabas un buen de código,

Private Sub CommandButton211_Click()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Set h1 = Worksheets("zusammenfassung")
Set rango = h1.Range("b41:z51")
If OptionButton5 = True Then
'Kabelmenge TECSUM M1
Set rango = h1.Range("b41:z51")
With rango
    r = .Rows.Count: c = .Columns.Count
    For i = 1 To r
        For j = 1 To c
            .Cells(i, 1) = FRM_Multiprojek.Controls("textbox" & 109 + i).Text
            .Cells(i, 2) = FRM_Multiprojek.Controls("textbox" & 120 + i).Text
            .Cells(i, 3) = FRM_Multiprojek.Controls("textbox" & 131 + i).Text
            .Cells(i, 4) = FRM_Multiprojek.Controls("textbox" & 142 + i).Text
            .Cells(i, 5) = FRM_Multiprojek.Controls("textbox" & 399 + i).Text
            .Cells(i, 6) = FRM_Multiprojek.Controls("textbox" & 799 + i).Text
            .Cells(i, 7) = FRM_Multiprojek.Controls("textbox" & 153 + i).Text
            .Cells(i, 8) = FRM_Multiprojek.Controls("textbox" & 164 + i).Text
            .Cells(i, 9) = FRM_Multiprojek.Controls("textbox" & 175 + i).Text
            .Cells(i, 10) = FRM_Multiprojek.Controls("textbox" & 186 + i).Text
            .Cells(i, 11) = FRM_Multiprojek.Controls("textbox" & 196 + i).Text
            .Cells(i, 12) = FRM_Multiprojek.Controls("textbox" & 208 + i).Text
            .Cells(i, 13) = FRM_Multiprojek.Controls("textbox" & 219 + i).Text
            .Cells(i, 14) = FRM_Multiprojek.Controls("textbox" & 231 + i).Text
            .Cells(i, 15) = FRM_Multiprojek.Controls("textbox" & 253 + i).Text
        Next j
    Next i
End With
ElseIf OptionButton6 = True Then
Set rango = h1.Range("u41:ak51")
With rango
    r = .Rows.Count: c = .Columns.Count
    For i = 1 To r
        For j = 1 To c
            .Cells(i, 18) = FRM_Multiprojek.Controls("textbox" & 109 + i).Text
            .Cells(i, 19) = FRM_Multiprojek.Controls("textbox" & 120 + i).Text
            .Cells(i, 20) = FRM_Multiprojek.Controls("textbox" & 131 + i).Text
            .Cells(i, 21) = FRM_Multiprojek.Controls("textbox" & 142 + i).Text
            .Cells(i, 22) = FRM_Multiprojek.Controls("textbox" & 399 + i).Text
            .Cells(i, 23) = FRM_Multiprojek.Controls("textbox" & 799 + i).Text
            .Cells(i, 24) = FRM_Multiprojek.Controls("textbox" & 153 + i).Text
            .Cells(i, 25) = FRM_Multiprojek.Controls("textbox" & 164 + i).Text
            .Cells(i, 25) = FRM_Multiprojek.Controls("textbox" & 175 + i).Text
            .Cells(i, 26) = FRM_Multiprojek.Controls("textbox" & 186 + i).Text
            .Cells(i, 27) = FRM_Multiprojek.Controls("textbox" & 196 + i).Text
            .Cells(i, 28) = FRM_Multiprojek.Controls("textbox" & 208 + i).Text
            .Cells(i, 29) = FRM_Multiprojek.Controls("textbox" & 219 + i).Text
            .Cells(i, 30) = FRM_Multiprojek.Controls("textbox" & 231 + i).Text
            .Cells(i, 31) = FRM_Multiprojek.Controls("textbox" & 253 + i).Text
        Next j
    Next i
End With
ElseIf OptionButton7 = True Then
Set rango = h1.Range("an41:bd51")
With rango
    r = .Rows.Count: c = .Columns.Count
    For i = 1 To r
        For j = 1 To c
            .Cells(i, 18) = FRM_Multiprojek.Controls("textbox" & 109 + i).Text
            .Cells(i, 19) = FRM_Multiprojek.Controls("textbox" & 120 + i).Text
            .Cells(i, 20) = FRM_Multiprojek.Controls("textbox" & 131 + i).Text
            .Cells(i, 21) = FRM_Multiprojek.Controls("textbox" & 142 + i).Text
            .Cells(i, 22) = FRM_Multiprojek.Controls("textbox" & 399 + i).Text
            .Cells(i, 23) = FRM_Multiprojek.Controls("textbox" & 799 + i).Text
            .Cells(i, 24) = FRM_Multiprojek.Controls("textbox" & 153 + i).Text
            .Cells(i, 25) = FRM_Multiprojek.Controls("textbox" & 164 + i).Text
            .Cells(i, 25) = FRM_Multiprojek.Controls("textbox" & 175 + i).Text
            .Cells(i, 26) = FRM_Multiprojek.Controls("textbox" & 186 + i).Text
            .Cells(i, 27) = FRM_Multiprojek.Controls("textbox" & 196 + i).Text
            .Cells(i, 28) = FRM_Multiprojek.Controls("textbox" & 208 + i).Text
            .Cells(i, 29) = FRM_Multiprojek.Controls("textbox" & 219 + i).Text
            .Cells(i, 30) = FRM_Multiprojek.Controls("textbox" & 231 + i).Text
            .Cells(i, 31) = FRM_Multiprojek.Controls("textbox" & 253 + i).Text
        Next j
    Next i
End With
ElseIf OptionButton8 = True Then
Set rango = h1.Range("bg41:bw51")
With rango
    r = .Rows.Count: c = .Columns.Count
    For i = 1 To r
        For j = 1 To c
            .Cells(i, 18) = FRM_Multiprojek.Controls("textbox" & 109 + i).Text
            .Cells(i, 19) = FRM_Multiprojek.Controls("textbox" & 120 + i).Text
            .Cells(i, 20) = FRM_Multiprojek.Controls("textbox" & 131 + i).Text
            .Cells(i, 21) = FRM_Multiprojek.Controls("textbox" & 142 + i).Text
            .Cells(i, 22) = FRM_Multiprojek.Controls("textbox" & 399 + i).Text
            .Cells(i, 23) = FRM_Multiprojek.Controls("textbox" & 799 + i).Text
            .Cells(i, 24) = FRM_Multiprojek.Controls("textbox" & 153 + i).Text
            .Cells(i, 25) = FRM_Multiprojek.Controls("textbox" & 164 + i).Text
            .Cells(i, 25) = FRM_Multiprojek.Controls("textbox" & 175 + i).Text
            .Cells(i, 26) = FRM_Multiprojek.Controls("textbox" & 186 + i).Text
            .Cells(i, 27) = FRM_Multiprojek.Controls("textbox" & 197 + i).Text
            .Cells(i, 28) = FRM_Multiprojek.Controls("textbox" & 208 + i).Text
            .Cells(i, 29) = FRM_Multiprojek.Controls("textbox" & 219 + i).Text
            .Cells(i, 30) = FRM_Multiprojek.Controls("textbox" & 231 + i).Text
            .Cells(i, 31) = FRM_Multiprojek.Controls("textbox" & 253 + i).Text
        Next j
    Next i
End With
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.CutCopyMode = False
End Sub

¡Gracias! Un millón de Gracias, ya funciona. Nuevamente gracias.

Que tengas un buen fin de semanas

Saludos

Eusebio

Disculpa nuevamente. Me funciona pero en mi listado Textbox no coincide con los textbox que me escribes . Y necesito saber como lograste eso, pues lo veo muy importante por el ahorro de tiempo. Tengo un listado de Textbox en columna y las he analizado con tú ejemplo y no me coincide con lo que me has echo

Saludos

Eusebio

Segunveo en tú ejemplo, tú tomas los Texbox de la parte inferior es decir para cada useform columna tomas los textboxes inferiores.

A mi me ocurre que se me corren los Textboxe solo las dos primeras columnas coinciden y luego los valores están en la siguiente columna

Eusebio

La orden Set rango = h1. Range("b41:z51") es la que define donde caerán los datos en este caso se el área abarcara desde la celda b41 a la celda z51, y las columnas quedaran definidas así, b=1, c=2 y así hasta llegar a la columna Z, y es como esta asignada la captura con los ciclos for .cells(i, 1)=... usercontrols("textbox" & 109+i).text, le esta indicando que en la fila con el valor de i=1, y columna 1 coloque el valor del textbox110, en la fila 2 y la columna 1 colocara el valor tel textbox111 y así sucesivamente, una vez que termina con esa columna pasara a la siguiente, de hecho lo único que tienes que cambiar es el valor del set donde tienes desfasados los datos, ajustándolos a tus datos. Por ejemplo si set rango=range("bb41:zb41") no corresponde a la captura de datos entonces solo mueves el área si set rango=range("ab41:yb41")

¡Gracias! Yo entiendo todo eso, lo que no entiendo, lo que no entiendo es que yo tengo cerca de 120 Textboxes y cuales debo coger, pues en la muestra que me envías no se ajustan a los míos y cuando los hago con los míos se corren a otras positiones. Por eso te pregunte si se cogen los textboxes que están en la parte inferior de mi userform

Eusebio

Respuesta
2

[Hola

Pues la primera recomendación es dividir en varios procedimientos, lo cual la verdad es relativamente simple; si no entiendes/sabes como hacerlo, pues la otra recomendación es que borres las líneas en blanco y las líneas comentadas, quizá eso ayude.

Abraham Valencia

PD: Sigues intentando hacer todo un "sistema" con VBA y Excel, si tanta es tu necesidad sugiero migrar a VB Net o VC++ o similar. Si vas a seguir insistiendo con VBA, necesitas un curso de programación.

Respuesta
1

Seria conveniente que subas un ejemplo de tu proyecto para revisarlo. Yo he trabajado con proyectos parecidos y no he tenido problemas.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Al seleccionar celda extraer sus dígitos automáticamente

Necesito dos favores, la idea es que al seleccionar una celda numérica de 4 dígitos del rango "af1;aj42" esta automáticamente extraiga sus cifras a la columna "a1, b1, c1, d1" como se muestra en la imagen Y lo segundo como puedo quitarle el msgbox a...
2 respuestas

Se puede agregar voz a Excel

Tengo una pantalla de vuelo de vuelo donde anotó despegues y arribos, Quiero que cada vez que se produzca un despegue y se agregue hora o aterrice alguno y se ponga la hora, excel diga o se escuche atención Aterrizaje o Atención despegue.
3 respuestas

Gráfico Comparativo por Semanas, en Power Bi.

Espero se encuentren muy bien. Tengo una tabla en Power BI con fechas, códigos, costos y cantidades. La necesidad que tengo es de crear un gráfico o tabla donde pueda comparar y analizar el comportamiento de los costos y las cantidades de un código...
1 respuesta

En una lista para pedidos tengo varios formularios

En una lista para pedidos con varios formularios la vengo usando desde hace tiempo sin ningún problema pero hace días la abrí para hacer un pedido y al pisar en el cuadro donde apunta la flecha para que me abra un otro cuadro donde coloco ciertos...
2 respuestas

Código VBA para crear un botón y guardar en PDF

Tengo un archivo word con 7 capturas, una en cada página (1-7), cual seria el código para crear un botón en la barra de herramientas de acceso rápido para convertir en PDF cada página. El resultado seria 7 pdf.
2 respuestas

Detectar si he marcado Celda dentro de un Rango de Excel.

Tengo un Rango en Hoja Excel: RgoDatos >> $B$3:$V$39 Quiero detectar si la celda que selecciono está dentro de ese Rango Si no está que por omisión me marque B3.
1 respuesta

Dato fecha ya existe en tabla

Como están estimados maestros. En formulario, tengo botón archivar. Envío información a hoja "existencias" a tabla "tbl_existencias". En columna A un Código desde textbox1 En columna B fecha desde textbox "txtFecha2" En columna C total desde textbox2...
2 respuestas

Enviar hoja activa al monitor secundario con vba

He creado una segunda ventana de mi hoja excel con NewWindow, y lo que pretendo es mediante código VBA enviarla al monitor secundario, lo he intentado con Application.SendKeys "^({ESC}+{RIGHT})", pero no lo consigo, con "^{ESC}" estoy tratando de...
2 respuestas

Ingresar información en una hoja y rescatar los datos principales en otra hoja ordenadamente.

Debo hacer cotizaciones y necesito guardar la información de los datos de las personas en una BD, sin ocupar Tablas. Lo principal de esto es que queden ordenada según el número de la cotización y mantener el número correlativo de la cantidad de...
1 respuesta

Como habilitar la Pestaña Automatización en Excel de Office 2021

Quisiera saber cual es el procedimiento para habilitar la pestaña Automatización en Excel 2021 o donde poder bajar ese complemento.
1 respuesta