Código de bucle para enviar muchas textbox

Soy un asiduo de este foro, porque sois magníficos. En este caso necesito ayuda porque no consigo realizar un blucle. Soy novato en VBA excel. Tengo un formulario con muchos texbox asociados a checkbox (en total 89) . La idea es que marcado el checkbox me envíe el textbox a otra hoja par realizar presupuesto de un material con opcionales. Lo he conseguido pero realizando línea por línea, pero me gustaría realizar un bucle para no tener tantas líneas de códigos. Anexo el código que tengo pero que no me funciona.

Private Sub BEnviar_Click()

Worksheets("Hoja3").Select

Ultimafila = 1 + Sheets("Hoja3").Cells(Rows.Count, "B").End(xlUp).Row
Cells(Ultimafila, 1).FormulaR1C1 = "F2_Chillers"
Cells(Ultimafila, 2) = Me.TextBox1.Value
Cells(Ultimafila, 3) = Me.TBUd.Value
Cells(Ultimafila, 4).FormulaR1C1 = Me.TextBox6.Value

'For Q = 1 To 20

' If CheckBox1 = True Then
' Ultimafila = 1 + Sheets("Hoja3").Cells(Rows.Count, "B").End(xlUp).Row
'Cells(Ultimafila, 1).FormulaR1C1 = "F2_Chillers_Acc"
'Cells(Ultimafila, 2).FormulaR1C1 = Me("TBOp" & Q).Value
'Cells(Ultimafila, 3).FormulaR1C1 = Me.TBUd.Value
'Cells(Ultimafila, 4).FormulaR1C1 = Me("Opc" & Q).Value
'End If
'Next Q

If CheckBox1 = True Then
Ultimafila = 1 + Sheets("Hoja3").Cells(Rows.Count, "B").End(xlUp).Row
Cells(Ultimafila, 1).FormulaR1C1 = "F2_Chillers_Acc"
Cells(Ultimafila, 2).FormulaR1C1 = Me.TBOp1.Value
Cells(Ultimafila, 3).FormulaR1C1 = Me.TBUd.Value
Cells(Ultimafila, 4).FormulaR1C1 = Me.Opc1.Value
End If

If CheckBox2 = True Then
Ultimafila = 1 + Sheets("Hoja3").Cells(Rows.Count, "B").End(xlUp).Row
Cells(Ultimafila, 1).FormulaR1C1 = "F2_Chillers_Acc"
Cells(Ultimafila, 2).FormulaR1C1 = Me.TBOp2.Value
Cells(Ultimafila, 3).FormulaR1C1 = Me.TBUd.Value
Cells(Ultimafila, 4).FormulaR1C1 = Me.Opc2.Value
End If

Lo que tengo con coma es el bucle que no consigo que funcione, porque aunque el checkbox no esté marcado lo envía, en cambio las analizando uno por uno si funciona.

Respuesta
1

Envíame una muestra de la hoja con los controles con sus nombres reales, para no perder tiempo dibujándolos y te coloco el bucle. Mis correos aparecen en mi sitio que dejo al pie.

¡Muchas Gracias! , te lo remito

Adjunto macro (estabas bastante cerca de la solución ;)

Para el Checkbox1 y col 4 tomé el código que encontré ... pero quizás ya no necesites evaluar el contenido de OPc.

Private Sub BEnviar_Click()
'arreglado x Elsamatilde
Worksheets("Hoja3").Select
Ultimafila = 1 + Cells(Rows.Count, "B").End(xlUp).Row   'la hoja ya está seleccionada
Cells(Ultimafila, 1) = "F2_Chillers"      'los textos y valores se mueven sin Formula
Cells(Ultimafila, 2) = Me.TBMat1.Value
Cells(Ultimafila, 3) = Me.TBUd.Value
Cells(Ultimafila, 4) = CDbl(TBMat6)
For Q = 1 To 20
    If Me.Controls("CheckBox" & Q) = True Then
        Ultimafila = 1 + Cells(Rows.Count, "B").End(xlUp).Row
        Cells(Ultimafila, 1) = "F2_Chillers_Acc"
        Cells(Ultimafila, 2) = Me.Controls("TextBox" & Q).Value
        Cells(Ultimafila, 3) = Me.TBUd.Value
        If Me.Controls("Opc" & Q) = "STD" Then
            Cells(Ultimafila, 4) = Me.Controls("Opc" & Q).Value
        Else
            Cells(Ultimafila, 4) = CDbl(Me.Controls("Opc" & Q))
        End If
    End If
Next Q
Unload Me
Worksheets("Chillers").Select
End Sub

Hice además algunas mejoras comentadas en la misma macro.

Sdos.

Elsa

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas