Transfer records to another worksheet [Solved/Closed]
Hello,
I have tried everything to move these records to a sheet called "Data" , but I wasn't able to get any good results. what I have been trying its underlined and the the records i want to transfer are in bold.
Private Sub CommandButton1_Click()
Dim sTgtSht As String
Dim sComboSht As String
Dim sTicketSht As String
Dim rngLastCell As Range
Dim lLastRow As Long
Dim sActiveSheet As String
Dim iListCount As Long
Dim lDelRow As Long
Dim bDel As Boolean
Dim R1 As String
sComboSht = "Combo"
sTicketSht = "TICKETS"
sActiveSheet = ActiveSheet.Name
sTgtSht = ComboBox1.Value
bDel = False
If (sTgtSht = "") Then
MsgBox "No target sheet select."
GoTo End_Sub
End If
On Error Resume Next
Sheets(sTgtSht).Select
Err.Clear
On Error GoTo 0
If ActiveSheet.Name <> Sheets(sTgtSht).Name Then
MsgBox "Sheet '" & sTgtSht & "' not found."
GoTo End_Sub
End If
Set rngLastCell = Sheets(sTgtSht).Cells.Find("*", Cells(1, 1), , , xlByRows, xlPrevious)
If rngLastCell Is Nothing Then
lLastRow = 1
Else
lLastRow = rngLastCell.Row
End If
Set rngLastCell = Nothing
For iListCount = ListBox1.ListCount - 1 To 0 Step -1
If ListBox1.Selected(iListCount) = True Then
bDel = True
lLastRow = lLastRow + 1
ListBox1.Selected(iListCount) = False
Sheets(sTgtSht).Cells(lLastRow, "A") = ListBox1.List(iListCount, 0)
Sheets(sTgtSht).Cells(lLastRow, "B") = ListBox1.List(iListCount, 1)
With Sheets("sTgtSht")
R1 = Sheets(sTgtSht).Cells(lLastRow, "A") = ListBox1.List(iListCount, 0)
Cells(R1).Copy Sheets("DATA").Range("A65536").End(xlUp)(2)
End With
lDelRow = Sheets(sComboSht).Cells(iListCount, "C")
Sheets(sTicketSht).Rows(lDelRow + 1).Delete
End If
Next iListCount
MsgBox lDelRow + 1 & " Containers copied To " & sTgtSht
If (bDel) Then
On Error Resume Next
ThisWorkbook.Names("INVOICE").Delete
On Error GoTo 0
ThisWorkbook.Names.Add Name:="INVOICE", RefersTo:=Worksheets(sTicketSht).Range("A2", "A31")
Call ComboBox2_Change
End If
End_Sub:
Sheets(sActiveSheet).Select
End Sub
Thank you