elwayisgod
New Member
- Joined
- Apr 1, 2012
- Messages
- 5
Hi,
I have a spreadsheet that has 2 tabs 'Retrieval' and 'Master' I have a button on 'Retrieval' with this code attached that needs these changes:
1-Instead of copying I need it to 'Move' the rows selected to 'Master' tab.
2-I don't want it to clear Master tab first. It actually needs to append to what previously may have moved.
3-Still sort by Column B on Master tab.
4-A button added to 'Master' tab that can move the selected rows back to the 'Retrieval' tab. When they are moved back to Master, need it to sort by Column B to make sure they are in order.
5-If you email me at 'elwayisgod@hotmail.com' I can send you my file so you can easily see what I'm trying to accomplish.
Option Explicit
Sub CopyFromRetrieval()
Dim rngData As range
Dim rngResult As range
Dim rngHeaders As range
Dim NoCols As Long
Dim rngDst As range
Dim rngCrit As range
Dim LastRow As Long
application.ScreenUpdating = False
With Worksheets("Retrieval")
LastRow = .range("B" & Rows.Count).End(xlUp).Row
Set rngData = .range("A14:U1" & LastRow)
End With
Set rngHeaders = rngData.Rows(1)
NoCols = rngData.Columns.Count
rngHeaders.Cells(1, 1).Value = "Field1"
rngData.Cells(1, 1).AutoFill rngHeaders.Rows(1), xlFillDefault
With Worksheets("Master")
LastRow = .range("B" & Rows.Count).End(xlUp).Row
.range("B14:U" & LastRow).ClearContents
Set rngDst = .range("A14")
End With
Set rngCrit = Worksheets("Sheet3").range("A1:A2")
rngCrit.Value = application.Transpose(Array("Field1", "Copy"))
rngData.AdvancedFilter xlFilterCopy, rngCrit, rngCrit.Cells(1, 1).Offset(, 2), True
rngHeaders.ClearContents
rngCrit.Resize(, 2).EntireColumn.Delete
LastRow = Worksheets("Sheet3").range("A" & Rows.Count).End(xlUp).Row
Set rngResult = Worksheets("Sheet3").range("A2:U" & LastRow)
rngResult.Copy
rngDst.PasteSpecial xlPasteValues
rngResult.EntireColumn.Clear
rngDst.EntireColumn.Clear
application.ScreenUpdating = True
application.CutCopyMode = False
End Sub
I have a spreadsheet that has 2 tabs 'Retrieval' and 'Master' I have a button on 'Retrieval' with this code attached that needs these changes:
1-Instead of copying I need it to 'Move' the rows selected to 'Master' tab.
2-I don't want it to clear Master tab first. It actually needs to append to what previously may have moved.
3-Still sort by Column B on Master tab.
4-A button added to 'Master' tab that can move the selected rows back to the 'Retrieval' tab. When they are moved back to Master, need it to sort by Column B to make sure they are in order.
5-If you email me at 'elwayisgod@hotmail.com' I can send you my file so you can easily see what I'm trying to accomplish.
Option Explicit
Sub CopyFromRetrieval()
Dim rngData As range
Dim rngResult As range
Dim rngHeaders As range
Dim NoCols As Long
Dim rngDst As range
Dim rngCrit As range
Dim LastRow As Long
application.ScreenUpdating = False
With Worksheets("Retrieval")
LastRow = .range("B" & Rows.Count).End(xlUp).Row
Set rngData = .range("A14:U1" & LastRow)
End With
Set rngHeaders = rngData.Rows(1)
NoCols = rngData.Columns.Count
rngHeaders.Cells(1, 1).Value = "Field1"
rngData.Cells(1, 1).AutoFill rngHeaders.Rows(1), xlFillDefault
With Worksheets("Master")
LastRow = .range("B" & Rows.Count).End(xlUp).Row
.range("B14:U" & LastRow).ClearContents
Set rngDst = .range("A14")
End With
Set rngCrit = Worksheets("Sheet3").range("A1:A2")
rngCrit.Value = application.Transpose(Array("Field1", "Copy"))
rngData.AdvancedFilter xlFilterCopy, rngCrit, rngCrit.Cells(1, 1).Offset(, 2), True
rngHeaders.ClearContents
rngCrit.Resize(, 2).EntireColumn.Delete
LastRow = Worksheets("Sheet3").range("A" & Rows.Count).End(xlUp).Row
Set rngResult = Worksheets("Sheet3").range("A2:U" & LastRow)
rngResult.Copy
rngDst.PasteSpecial xlPasteValues
rngResult.EntireColumn.Clear
rngDst.EntireColumn.Clear
application.ScreenUpdating = True
application.CutCopyMode = False
End Sub