Automatically Insert Row

[marreco]

Hi.
But is this spreadsheet I'm trying to be automatically added rows.

Eg

In part that has "Locação de Equipamentos" ... when I, after filling out all the lines and need to add the item 6, I would like some command line that is automatically created and that all formulas of the previous line is it also .

Same thing on the part of "Cessão de mão de obra"

Thank you folks.

[LalitPandey87]

Hi marreco,

Could you please explain it more.

[Rajan_Verma]

would be better if you can make it more clear

[Excel Fox]

I would suggest you use a data table to do this.

[marreco]

Hi.
imagine that I have a new item that will be inserted into the "LOCAÇÃO DO EQUIPAMENTO"
Then in line 7 will always be shifted down so that the new item (5) is put.

[LalitPandey87]

Step 1:- Create Name Range for Cell B8 and named it 'rngSubTotalPart1'
Step 2:- Create Name Range for Cell B15 and named it 'rngSubTotalPart2'
Step 3:- Press Alt + F11 -> Alt + I + M and Paste below code in the module

Const strPart1RangeName                 As String = "rngSubTotalPart1"
Const strPart2RangeName                 As String = "rngSubTotalPart2"

Sub InsertRowFor_LOCACAO_DO_EQUIPAMENTO()

    InsertRow strPart1RangeName

End Sub

Sub InsertRowFor_CESSAO_DE_MAODE_OBRA()

    InsertRow strPart2RangeName

End Sub

Sub InsertRow(ByVal strSubTotalRange As String)

    Dim wksSht                  As Worksheet
    
    If Application.ScreenUpdating Then Application.ScreenUpdating = False
    
    Set wksSht = ThisWorkbook.Worksheets("Plan1")
    
    With wksSht
        With .Range(strSubTotalRange).Offset(-1)
            If .Value = "" Then
                MsgBox "Row Already inserted. May be it is not filled.", vbInformation, "Row insert..."
                GoTo ErlyExit
            End If
            .EntireRow.Copy
            .EntireRow.Insert Shift:=xlDown
            Application.CutCopyMode = False
            If strSubTotalRange = strPart1RangeName Then
                .Resize(, 5).Value = ""
                .Offset(, 7).Value = ""
                .Offset(, 10).Resize(, 2).Clear
            ElseIf strSubTotalRange = strPart2RangeName Then
                .Resize(, 6).Value = ""
            End If
        End With
    End With
  
ErlyExit:
    If Not Application.ScreenUpdating Then Application.ScreenUpdating = True

End Sub

Step 4:- Close This Window (Alt + F4)
Step 5:- Insert a Shape and right click on it -> click on Assign Macro and assign InsertRowFor_LOCACAO_DO_EQUIPAMENTO macro from the macro list in the pop up window.
Step 6:- Insert another shape, right click on shape, click on assign macro and assign InsertRowFor_CESSAO_DE_MAODE_OBRA macro to this one.
Step 7:- Done

[marreco]

Hi.

after inserting a row, I can not insert any more line

Thank you!!

[LalitPandey87]

Replace the above code with this one

Const strPart1RangeName                 As String = "rngSubTotalPart1"
Const strPart2RangeName                 As String = "rngSubTotalPart2"

Sub InsertRowFor_LOCACAO_DO_EQUIPAMENTO()

    InsertRow strPart1RangeName

End Sub

Sub InsertRowFor_CESSAO_DE_MAODE_OBRA()

    InsertRow strPart2RangeName

End Sub

Sub InsertRow(ByVal strSubTotalRange As String)

    Dim wksSht                  As Worksheet
    
    If Application.ScreenUpdating Then Application.ScreenUpdating = False
    
    Set wksSht = ThisWorkbook.Worksheets("Plan1")
    
    With wksSht
        With .Range(strSubTotalRange).Offset(-1)           
            .EntireRow.Copy
            .EntireRow.Insert Shift:=xlDown
            Application.CutCopyMode = False
            If strSubTotalRange = strPart1RangeName Then
                .Resize(, 5).Value = ""
                .Offset(, 7).Value = ""
                .Offset(, 10).Resize(, 2).Clear
            ElseIf strSubTotalRange = strPart2RangeName Then
                .Resize(, 6).Value = ""
            End If
        End With
    End With
  
ErlyExit:
    set wksSht = Nothing
    If Not Application.ScreenUpdating Then Application.ScreenUpdating = True

End Sub