¿Cómo añadir celdas según valor?

No se ven las imágenes, puedes poner otras o envíame tu archivo con la macro y con los datos, en cada hoja me pones los datos, de lo que tienes, cómo te queda y cómo quieres que te quede.

Mi correo [email protected]

En el asunto del correo escribe tu nombre de usuario “Andres Reyes” y el título de esta pregunta.

Dante Amor

Te envíe el correo, saludos. Quedo en espera de tu pronta respuesta.

Prueba con esta macro:

Sub celdas()
'Por.Dante Amor
    For i = 3 To Range("F" & Rows.Count).End(xlUp).Row
        n = i
        If Cells(i, "F") > 0 And Cells(i, "G") > 0 Then
            For j = 1 To Cells(i, "G")
                Cells(n, "G") = j
                n = n + 1
            Next
        End If
        n = i
        If Cells(i, "F") > 0 And Cells(i, "H") > 0 Then
            For j = 1 To Cells(i, "H")
                Cells(n, "H") = j
                n = n + 1
            Next
        End If
    Next
    MsgBox "terminado"
End Sub

Saludos.Dante Amor

Si es lo que necesitas.

Probando tu macro, por ahí va el asunto, conteste a tu correo.

Saludos y gracias.

Te anexo la macro para verificar la cantidad y lo asignado. Y para poner los textos.

Sub celdas()
'Por.Dante Amor
    For i = 3 To Range("F" & Rows.Count).End(xlUp).Row
        n = i
        ini = Columns("G").Column
        fin = Columns("I").Column
        If Cells(i, "F") > 0 Then
            wsum = Application.Sum(Range(Cells(i, ini), Cells(i, fin)))
            If Cells(i, "F") <> wsum Then
                Cells(i, "F").Interior.ColorIndex = 6
                MsgBox "La Cantidad no es igual a lo asignado"
            Else
                For k = ini To fin
                    If Cells(i, k) > 0 Then
                        num = Cells(i, k)
                        Cells(i, k) = ""
                        For j = 1 To num
                            Cells(n, k) = Cells(2, k)
                            n = n + 1
                        Next
                    End If
                Next
            End If
        End If
    Next
    MsgBox "terminado"
End Sub

Vamos a ocupar tu macro para insertar filas, lo único que falta es llamar a la macro "celdas", después de la instrucción Loop:

Sub InsertarFilasCantidadCodigo()
    Dim filas As Integer
    Dim var As Integer
    filas = 3
    Do Until Cells(filas, 6) = ""
        If Cells(filas, 6) <> 0 Or Cells(filas, 6) <> "" Or Val(Cells(filas, 6)) > 0 Then
            var = Cells(filas, 6) - 1
            For m = 1 To var
                Rows(filas + 1).Select
                Selection.Insert
            Next m
        End If
        filas = filas + var + 1
    Loop
    celdas
End Sub

Saludos.Dante Amor

Recuerda cambiar la valoración de la respuesta.

Dante, eres una gran persona, me ayudaste con mi rompecabezas.

¡De verdad Mil Gracias!