Sub insertBlankRows()
Dim L As Integer
Dim C As Integer
Dim n As Integer
Dim v As Integer
Dim intervalo As Integer
L = 1
intervalo = InputBox(Prompt:="Digite o número referente ao intervalo desejado", _
Title:="Inserir dado de inervalo", Default:="3")
Do
L = L + 1
If Cells(L, 1).Value = "" Then Exit Do
n = n + 1
If n > intervalo Then
For v = 1 To 3
Rows(L).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Next v
L = L + intervalo - 1
For C = 1 To 12
Cells(L, C).Value = Cells(1, C).Value
Cells(L - 2, 8).FormulaR1C1 = "=SUM(R[-3]C:R[-1]C)"
Cells(L - 2, 9).FormulaR1C1 = "=SUM(R[-3]C:R[-1]C)"
Cells(L - 2, 10).FormulaR1C1 = "=SUM(R[-3]C:R[-1]C)"
Cells(L - 2, 11).FormulaR1C1 = "=SUM(R[-3]C:R[-1]C)"
Cells(L - 2, 13).FormulaR1C1 = "=SUM(RC[-5]:RC[-1])"
Next C
Range(Cells(L, 1), Cells(L, 12)).Font.Bold = True
Range(Cells(L - 2, 8), Cells(L - 2, 13)).Font.Bold = True
Range(Cells(L - 2, 13), Cells(L - 2, 13)).Font.Color = -16776961
n = 0
End If
Loop
Cells(L, 8).FormulaR1C1 = "=SUM(R[-3]C:R[-1]C)"
Cells(L, 9).FormulaR1C1 = "=SUM(R[-3]C:R[-1]C)"
Cells(L, 10).FormulaR1C1 = "=SUM(R[-3]C:R[-1]C)"
Cells(L, 11).FormulaR1C1 = "=SUM(R[-3]C:R[-1]C)"
Cells(L, 13).FormulaR1C1 = "=SUM(RC[-5]:RC[-1])"
Range(Cells(L, 8), Cells(L, 13)).Font.Bold = True
Range(Cells(L, 13), Cells(L, 13)).Font.Color = -16776961
End Sub
Postado : 09/07/2015 8:53 pm