Good Day
I am new to this forum.
I having a issue I am trying to copy non contiguous rows from one sheet to another.
The code below works perfectly fine when the Asset is highlighted on the list Box. Due to the number of records, I use the search option and the record is found and when I try to move the Asset to another sheet, the first record on the list is selected and moved to Sheet7 which is incorrect.
The code I have is as follows
I have attached sample sheet for clarity
The password for Sheet4 is Secret
Thanks
I am new to this forum.
I having a issue I am trying to copy non contiguous rows from one sheet to another.
The code below works perfectly fine when the Asset is highlighted on the list Box. Due to the number of records, I use the search option and the record is found and when I try to move the Asset to another sheet, the first record on the list is selected and moved to Sheet7 which is incorrect.
The code I have is as follows
Code:
Private Sub Image37_Click() 'Asset Transfer to New Sheet
Worksheets("Sheet7").Unprotect password:="Secret"
Dim lngSelected As Long, lngRows As Long
Dim CopyRng As Range
Dim lo As ListRow
Set lo = Sheets("Sheet7").ListObjects("Table1457").ListRows.Add
If ListBox1.Text = "" Then
MsgBox "Select a Record to Transfer to Asset Disposal List...", vbCritical
Exit Sub
End If
If MsgBox("Would you like to Transfer Asset to Asset Disposal List. This will remove record from Asset Register and cannot be undone...?", vbQuestion + vbYesNo) <> vbYes Then
Exit Sub
End If
For lngSelected = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(lngSelected) Then
lngRows = lngSelected + 4
Me.ListBox1.RemoveItem lngSelected
With Sheets("sheet4")
Set CopyRng = Union(.Range(.Cells(lngRows, 1), .Cells(lngRows, 6)), .Range(.Cells(lngRows, 41), .Cells(lngRows, 44)))
CopyRng.Copy
lo.Range.PasteSpecial Paste:=xlPasteValues
.Rows(lngRows).Delete
End With
End If
Next lngSelected
MsgBox "Rows " & lngRows & " Copied To Asset Disposal Sheet"
MsgBox "Asset Transferred to Asset Disposal List and removed from Asset Register!"
Application.CutCopyMode = False
Sheets("Sheet7").Protect
Sheets("Sheet4").Protect
End Sub
I have attached sample sheet for clarity
The password for Sheet4 is Secret
Thanks