I'm stuck trying to delete a row in a table after copying and pasting it to another Workbook table. It worked when I was activating workbooks and sheets but now has stopped. Can this be done the way I have the code now? Any help is greatly appreciated. I have been trying to fix this for two days now..
Sub MoveOrdertoDelivery()
'
' Move_Order Macro
' Move the next line on the Delivery Log for the day
'
'*************************************************************************
' New Code for MoveLinetoDeliverySchedule
'*************************************************************************
Dim copyrng As Range
Dim rngOld As Range
Dim msgRes As VbMsgBoxResult
Dim checkcellrange As Range
Dim strFileDir As String
' new to use the better code****DELETE AFTER IT WORKS
Dim destinationSheetName As String
Dim originatingWorkbookName As String
Dim originatingWorkbook As Workbook
Dim destinationWorkbook As Workbook
Dim originatingSheetName As String
Dim destinationFileName As String
Dim originatingTableName As String
Dim destinationTableName As String
strFileDir = ThisWorkbook.Path
originatingWorkbookName = ActiveWorkbook.Name
originatingSheetName = ActiveSheet.Name
destinationFileName = strFileDir & "\Door Delivery Schedule.xlsm"
Set checkcellrange = Range("A1:ZZ3")
Set rngOld = ActiveCell
Set originatingWorkbook = Workbooks.Open(strFileDir & "\" & originatingWorkbookName)
ActiveSheet.Cells(ActiveCell.Row, 1).Select
Set copyrng = Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 11))
copyrng.Select
If Intersect(checkcellrange, copyrng) Is Nothing Then
originatingTableName = ActiveCell.ListObject.Name
Else
msgRes = MsgBox("Please select a table Row!", vbOKCancel)
Exit Sub
End If
If Intersect(checkcellrange, rngOld) Is Nothing Then
If Not allBlank(ThisWorkbook.Sheets(originatingSheetName).Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 11))) Then
msgRes = MsgBox("Proceed?", vbOKCancel, "You are about to Move this row to the Door Delivery Schedule.")
If msgRes = vbOK Then
Selection.Copy
On Error Resume Next
tablerow = Selection.Row - Selection.ListObject.Range.Row
If Err.Number = 91 Then
MsgBox "Please select a line with data in it!"
Exit Sub
End If
'originatingWorkbook.Sheets(originatingSheetName).Range(ListObjects(originatingTableName).ListRows(tablerow)).Copy
'originatingWorkbook.Sheets(originatingSheetName).Range(copyrng).Copy
Set destinationWorkbook = Workbooks.Open(destinationFileName)
destinationWorkbook.Sheets("Orders For Delivery").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
destinationWorkbook.Save
destinationWorkbook.Close
'originatingWorkbook.Sheets(originatingSheetName).Selection.Delete Shift:=
Windows("Production Schedule Main.xlsm").Activate
Sheets("Completed Orders").Activate
copyrng.Select
originatingWorkbook.Sheets(originatingSheetName).Selection.ListObject.ListRows(tablerow).Delete
Selection.Delete Shift:=x1Up
Exit Sub
Else
End If
Else
MsgBox ("Please select a row with data in it.")
End If
Else
MsgBox ("Please select a legal row in the field.")
End If
End Sub