Solved

macro for cutting and pasting record onto new worksheet

Posted on 2013-05-23
9
409 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
  • 5
  • 4
9 Comments
 
LVL 14

Expert Comment

by:Faustulus
Comment Utility
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
Comment Utility
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
Comment Utility
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
 

Author Comment

by:shamilaz
Comment Utility
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
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 14

Expert Comment

by:Faustulus
Comment Utility
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
Comment Utility
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
Comment Utility
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 500 total points
Comment Utility
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
Comment Utility
thanks very much for your help & assistance.
0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

Deploying a Microsoft Access application in a Citrix environment is not difficult but takes a few steps. However, Citrix system people are often of little help, as they typically know next to nothing about Access. The script provided here will take …
PaperPort has a feature called the "Send To Bar". It provides a convenient, drag-and-drop interface for using other installed software, such as Microsoft Office. However, this article shows that the latest Office 2016 apps (installed with an Office …
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
Learn how to make your own table of contents in Microsoft Word using paragraph styles and the automatic table of contents tool. We'll be using the paragraph styles in Word’s Home toolbar to help you create a table of contents. Type out your initial …

728 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

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now