?
Solved

macro for cutting and pasting record onto new worksheet

Posted on 2013-05-23
9
Medium Priority
?
414 Views
Last Modified: 2013-06-05
Hi ,

I am looking for a macro to cut from one worksheet to another worksheet.  I have tried many macros by substituing my info without success.  Listed below is one such macro.

Sub MoveArchived()
Dim c As Range, port_sheet As Worksheet, reject_sheet As Worksheet, r As Range
Set port_sheet = Worksheets("Sheet1")
Set reject_sheet = Worksheets("Sheet2")
reject_column = 1
Application.ScreenUpdating = False
port_last_row = port_sheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
port_sheet.ListObjects("Table2").Range.AutoFilter Field:=reject_column, Criteria1:= _
    "=Archived", Operator:=xlOr
For Each r In port_sheet.ListObjects("Table2").Range.Rows
i = i + 1
    If i = 1 Then
        GoTo skip
        End If
    If r.Hidden = True Then GoTo skip
    reject_last_row = reject_sheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
    r.Copy
    reject_sheet.Range("A" & reject_last_row).PasteSpecial xlPasteValues
    reject_sheet.Range("A" & reject_last_row).PasteSpecial xlPasteFormats
skip:
Next r
Application.CutCopyMode = False
port_sheet.Rows("9:" & port_last_row).Delete Shift:=xlUp
port_sheet.ShowAllData
Application.ScreenUpdating = True
End Sub

Thanks very much

Mohamed
wan---lan.xlsm
0
Comment
Question by:shamilaz
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 4
9 Comments
 
LVL 14

Expert Comment

by:Faustulus
ID: 39193657
It will be difficult to discern your intentions from a macro of which you say that it doesn't do what you want. Why don't you post your workbook and describe what you wish to do? You can use representative data, but don't change the worksheets' structure. These are the questions that must be answered:-
1. Where to find the data to cut (which worksheet?).
2. How to find the data to cut (search criteria).
3. Where to paste the data that were cut (sheet and row).
4. What to do with the blank row remaining where the data were lifted.
0
 

Author Comment

by:shamilaz
ID: 39199223
Coulmn "A" has three options available via a drop down menu.  I am looking to move all records that  are "ARCHIVED" (When the "ARCHIVED" option is selected from this dropdown) from the WAN - LAN tab to the next available row on the WAN - LAN archive tab.  I would like a macro that would do that .   This way I could link the macro to a BUTTON and be able to move all ARCHIVED records.
wan---lan-27-5.xlsm
0
 
LVL 14

Expert Comment

by:Faustulus
ID: 39199973
The code is on the ArchiveMan module in the attached workbook. If you open both that workbook and your own you can just drag the module into your own project in the Project Explorer window of the VB Editor.
You can adjust the settings in Enum Nws. If you wish to start copying from a row other than row 2 or if you ever place the Status in another column these two values can be changed to match your new requirements without touching the actual code.
I have placed the button on the Admin tab. Right-click the button and press Copy. You can then paste it into any sheet in your own project. After pasting, right-clicking enables you to move it. Hover your cursor over the button until the cross-hairs appear, then drag the cross-hairs to where you want the button to be.
I hope this solution works well for you.
EXX-130528-Send-Rows-to-Archive.xlsm
0
NEW Veeam Agent for Microsoft Windows

Backup and recover physical and cloud-based servers and workstations, as well as endpoint devices that belong to remote users. Avoid downtime and data loss quickly and easily for Windows-based physical or public cloud-based workloads!

 

Author Comment

by:shamilaz
ID: 39206959
Hi There,

My apologies for the delayed response.  I tried many times to use this macro as instructed on my master spreadsheet without success unfortunately.

Also I have two more worksheets that would require the records to be moved.  As such I thought the best would be to work off of your worksheet, and to this end I have created the addytional tabs etc, and greatly appreciate if you could please build the additional macros into this existing spreadsheet which is attached.

instructions are as follows.

-WAN - LAN tab to WAN - LAN archive - Already completed by you
-WAN - LAN tab to WAN - LAN Closed - Need Macro
-Customer Facing WAN_LAN to Customer Facing WAN_LAN Archive - Need Macro
-Customer Facing WAN_LAN to Customer Facing WAN_LAN Closed - Need Macro
-IPT to IPT Archive - Need Macro
-IPT to IPT Closed - Need Macro

I can then move the records from the master spreadsheet once these records are available.

Thanks very much
EXX-130528-Send-Rows-to-Archive-.xlsm
0
 
LVL 14

Expert Comment

by:Faustulus
ID: 39209630
Please tell me about your intended processing.
1. Coming from WAN-LAN, will you wish to transfer to "Closed" and "Archive" in separate operations?
2. Do you need to trigger the action(s) defined in response to my above question separately for WAN-LAN, Customer facing Wan-Lan and IPT?

I wonder if you would like all transfer to be done whenever the workbook is opened? In that case you would not need any button at all.
0
 
LVL 14

Expert Comment

by:Faustulus
ID: 39209736
shamilaz,
I have programmed this thing for you the way I described above. If you wish to see the workbook as I created it please disable macros or Application events before you open it. If you don't all items marked closed or archived will be transferred and you only get to see the finished result. However, the changed workbook will not be saved.
If you don't like so much automation let me know. The code will be easy adapt to your requirements.
I have made drastic changes to your tab names, however. At the core of the system is the range Admin!A1:A3 which I have named as "Stati". It is important that the scope of this name is "Workbook", meaning you can use it anywhere in the workbook. I have changed the list for the data validations to point to =Stati on all sheets.
The purpose of this change is to unify the setting of the Data Validation and the search for items to move. In the earlier version the word "Archived" was embedded in the code. Now it isn't any more. Whatever you write in 'Stati' is what the code will be looking for.
Please observe the Enum Nst at the top of the code. Open/Close/Archive must remain in this sequence in the range Stati. If you change them, change the values of these enumerations as well and the code will run with the modified row numbers, except that Close and Archive must follow each other.
The next thing I did was to use these same words for the worksheet names:-
WAN-LAN
WAN-LAN Closed
WAN-LAN Archived
You had intended to use "WAN-LAN Archive" (without final d). I must have the d because it is the same word you use in Admin!A3. Change it there and the tab name must change with it.
Because I construct the Closed and Archived versions from the original tab name you can't have "Customer facing .." and "Customer fac ...". The code creates these names by adding words from Admin!A2 and Admin!A3 to the main names. The main names as used by the code are controlled by this line of code:
Const SheetNames As String = "WAN-LAN,WAN-LAN Customer,IPT"
I have changed "WAN - LAN" to "WAN-LAN". If you want your old name back you must modify both, the above constant AND the sheet's actual name. There is no automatic correction of errors in the naming. If the name produced by the code isn't found in the workbook a fatal error will occur.
Let me know if this can work for you.
EXX-130530-Send-Rows-to-Archive.xlsm
0
 

Author Comment

by:shamilaz
ID: 39216172
Would it be possible to transfer the Closed and archived in seperate operations, so that I can assign two seperate buttons for these.  Otherwise all is good.  Thanks very much
0
 
LVL 14

Accepted Solution

by:
Faustulus earned 2000 total points
ID: 39218084
Please replace the existing procedure 'TransferRecords' with the following code:-
Sub TransferClosed()
    TransferRecords NstClose
End Sub
    
Sub TransferArchived()
    TransferRecords NstArchive
End Sub

Sub TransferRecords(ByVal Marked As Nst)

    Const SheetNames As String = "WAN-LAN,WAN-LAN Customer,IPT"
    Dim Stati() As String
    Dim Sn() As String
    Dim WsS As Worksheet                ' S = Source
    Dim WsT As Worksheet                ' T = Target
    Dim i As Long
    
    Stati = GetStati
    Sn = Split(SheetNames, ",")
    For i = 0 To UBound(Sn)
        Set WsS = ThisWorkbook.Sheets(Sn(i))
        Set WsT = ThisWorkbook.Sheets(Sn(i) & " " & Stati(Marked))
        MoveRecords Stati(Marked), WsS, WsT
    Next i
End Sub

Open in new window

You can then set up different buttons to call the two new procedures, 'TransferClosed' and 'TransferArchived' independently.
0
 

Author Closing Comment

by:shamilaz
ID: 39222769
thanks very much for your help & assistance.
0

Featured Post

Get free NFR key for Veeam Availability Suite 9.5

Veeam is happy to provide a free NFR license (1 year, 2 sockets) to all certified IT Pros. The license allows for the non-production use of Veeam Availability Suite v9.5 in your home lab, without any feature limitations. It works for both VMware and Hyper-V environments

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes how to import an Outlook PST file to Office 365 using a third party product to avoid Microsoft's Azure command line tool, saving you time.
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

801 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question