Entry in Hidden and protected Sheet from Data entry Sheet

[Rahulkr]

Please help in achieving my task, I have tried to one macro to do some work in this workbook, actually I have prepared this excel for stock and inventory management as per our requirement. In this workbook I am taking data from Data entry sheet and pasting it in Stock out sheet with some remarks, but the content of the remarks is not getting pasted in Stock out sheet and it is pasted as #N/A. Any help is highly appreciated.

Data in the Data entry sheet(HOME) are kept in cell ("E10, E11, E12, E13, E15")

Sub St_OUT()
Dim r As Range, c As Range
Dim iRow As Long

[B] Set r = Range("E10:E13,E15")[/B]
For Each c In r
If c.Value = "" Then
MsgBox "Please Do Full Entry: " & c.Offset(, -1)
Exit Sub
End If
Next
With Sheets("STOCK OUT")
.Unprotect "123654"
With .ListObjects("Table3")
.ListRows.Add AlwaysInsert:=True
iRow = .DataBodyRange.Rows.Count
.DataBodyRange(iRow, 1).Resize(1, 5).Value = Application.Transpose(r.Value)
End With
.Protect "123654"
Sheets("HOME").Select
[B]Range("E10:E13,E15").ClearContents[/B]
ActiveWorkbook.Save
MsgBox "Data Saved Please Enter New Data !"
End With

End Sub

When I am running the above code it is not pasting the data of the E15 cell value in the STOCK OUT sheet.

Below is the output what I am getting.

DATE	ENTRY NO	ITEM NAME	QUANTITY	Remarks
01 January 2022	BLRSO/1	Tissue Roll	5	#N/A

Any help is highly appreciated. In Home sheet cell no E15 contains some data as remarks, but when running this code it is pasting all data in STOCK OUT Sheet, but only in remarks field the data is pasting as #N/A instead of the data what I need to copy and past in it.

 

[Alex Blakenburg]

The problem is with having a non-contiguous range of cells (ie skipping row 14), give this a try.

    Dim r As Range, c As Range
    Dim iRow As Long
    
    Dim arr() As Variant
    Dim i As Long
    
    Set r = Range("E10:E13,E15")
    ReDim arr(1 To r.Cells.Count)
    i = 0
    
    For Each c In r
        If c.Value = "" Then
            MsgBox "Please Do Full Entry: " & c.Offset(, -1)
            Exit Sub
        End If
        i = i + 1
        arr(i) = c.Value
    Next
    
    With Sheets("STOCK OUT")
        .Unprotect "123654"
        With .ListObjects("Table3")
            .ListRows.Add AlwaysInsert:=True
            iRow = .DataBodyRange.Rows.Count
            .DataBodyRange(iRow, 1).Resize(1, UBound(arr)).Value = arr
        End With
        .Protect "123654"
        Sheets("HOME").Select
        Range("E10:E13,E15").ClearContents
        ActiveWorkbook.Save
        MsgBox "Data Saved Please Enter New Data !"
    End With

End Sub

 

[Rahulkr]

The problem is with having a non-contiguous range of cells (ie skipping row 14), give this a try.

    Dim r As Range, c As Range
    Dim iRow As Long
   
    Dim arr() As Variant
    Dim i As Long
   
    Set r = Range("E10:E13,E15")
    ReDim arr(1 To r.Cells.Count)
    i = 0
   
    For Each c In r
        If c.Value = "" Then
            MsgBox "Please Do Full Entry: " & c.Offset(, -1)
            Exit Sub
        End If
        i = i + 1
        arr(i) = c.Value
    Next
   
    With Sheets("STOCK OUT")
        .Unprotect "123654"
        With .ListObjects("Table3")
            .ListRows.Add AlwaysInsert:=True
            iRow = .DataBodyRange.Rows.Count
            .DataBodyRange(iRow, 1).Resize(1, UBound(arr)).Value = arr
        End With
        .Protect "123654"
        Sheets("HOME").Select
        Range("E10:E13,E15").ClearContents
        ActiveWorkbook.Save
        MsgBox "Data Saved Please Enter New Data !"
    End With

End Sub

Thank you very much Alex Blakenburg it worked for me. It's highly appreciated. Thank you very much.

 

[Alex Blakenburg]

No problem, thanks for letting me know. Glad I could help.