First of all I have posted the same thread at mrexcel https://www.mrexcel.com/board/…ew-row-if-needed.1198559/
And here is my question and needed help.
First of all I need to say thank you to all of you that have helped me and write (tried and did) the below code.
The code is working perfectly!. What the code do is that it collect data from 3 or more sheets and insert them to another sheet in order to create an invoice. So far , so good.
The problem is that there is an alert if the inserted data are more than row 70 to end sub. Now there is the need to incremental add rows to invoice and not checking if they are more than 70.
Starts from Row 15 and add row if there is a need (ie retrieve more data from sheets and copy them). I have tried to make it happen using a tutorial from VBA Macro to Insert Row in Excel Based on https://www.exceldemy.com/exce…rt-row-based-on-criteria/ but no luck.
Also the row must have columns A B C and D has a formula (B*C) .Can someone please help to make this work?
You can find at the example workbook. The module needed to change is Invoice
Sub Invoice2() Dim ws As Variant, sht As Variant Dim i As Long, lr As Long, nr As Long, c As Long Dim cell As Range Dim N$ Dim ws1 As String ws1 = ActiveSheet.Name Application.ScreenUpdating = False ' Set array of worksheet names to copy from ws = Array("Dimmer") ' Array of columns to check sht = Array("D") nr = 15 Sheets("FORMA").Range("A15:C70").ClearContents ' Loop through all sheets in sheets array For i = LBound(ws) To UBound(ws) ' Loop through all columns in the column array For c = LBound(sht) To UBound(sht) ' Find last row in column with data With Sheets(ws(i)) lr = .Cells(Rows.Count, sht(c)).End(xlUp).Row ' Loop through all cells in column For Each cell In .Range(.Cells(1, sht(c)), .Cells(lr, sht(c))) ' Check to see if value is numeric and not 0 If (IsNumeric(cell.Value)) And (cell.Value <> 0) Then ' Copy cells C, D, E to columns A, B, C of main sheet .Range(.Cells(cell.Row, "C"), .Cells(cell.Row, "E")).Copy Sheets("FORMA").Cells(nr, "A").PasteSpecial Paste:=xlPasteValues ' Increment nr counter nr = nr + 1 ' Check to see if rows are full If nr > 70 Then MsgBox "Data Full" Exit Sub End If End If Next cell End With Next c Next i Application.ScreenUpdating = True End Sub