The Attachments contains a macro copying rows from a sheet and Paste to another sheet based on the row number , I want to copy and paste based on sequence in column A .
The Attachments contains a macro copying rows from a sheet and Paste to another sheet based on the row number , I want to copy and paste based on sequence in column A .
Last edited by aimanraya; 04-16-2014 at 11:30 AM.
This code will insert the rows at the position (cell selected by the user)...
This code will insert the row at the position (number typed by the user)...Sub cppy_psste() Dim InsertPos As Range Dim lStart As Long NS: On Error Resume Next Set InsertPos = Application.InputBox(Prompt:="Select the cell that you want to start at.", _ Title:="Paste rows", Type:=8) If Not InsertPos Is Nothing Then Application.ScreenUpdating = False Sheets("2").Rows("1:7").Copy InsertPos.Insert Shift:=xlDown Beep If MsgBox("Do you want to paste again?", vbYesNo + vbQuestion, "Paste rows") = vbYes _ Then GoTo NS Application.CutCopyMode = False Application.ScreenUpdating = True End If End Sub
Sub cppy_psste() Dim NumberRow As Long Dim lStart As Long NS: lStart = 0 NumberRow = Application.InputBox(Prompt:="Select the cell that you want to start at.", Title:="Paste rows", Type:=1) If NumberRow = 0 Then Exit Sub On Error Resume Next lStart = Range("A:A").Find(NumberRow).Row '+ 1 (Uncomment this line to insert rows below NumberRow) If lStart <> 0 Then Application.ScreenUpdating = False Sheets("2").Rows("1:7").Copy Rows(lStart & ":" & lStart + 6).Insert Shift:=xlDown Beep If MsgBox("Do you want to paste again?", vbYesNo + vbQuestion, "Paste rows") = vbYes Then GoTo NS Application.CutCopyMode = False Application.ScreenUpdating = True Else MsgBox "The value you supplied could not be found!", vbExclamation End If End Sub
Regards,
Rudi
The first code ,when the InputBox show to Select the cell that you want to start at , I can select only one because the InputBox show is active so I cant move down (it prevent me ). Also the second code , there is any way to able me move down sheet during InputBox show , I hope you understan me .
The second code , When I typed number 50, 100 , 150 .. It paste row below 49 , 99 , 149 . Also when I enter a number that does not Found in sequence, can show MsgBox " was not found!" ? Sorry I dont remark '+ 1 (Uncomment this line to insert rows below NumberRow) . only I want MsgBox if I typed any number not found , very tanks dear Rudis .
Last edited by aimanraya; 04-16-2014 at 05:37 PM.
Hi,
In both the code blocks, the rows will now be inserted *below* the indicated number.
Since the inputbox is an Application.Inputbox(...) it does allow for scrolling to numbers further down the list. In other words, when the inputbox is showing, you can either use the mouse wheel to scroll down, or you can drag the scroll bar of Excel down.
Sub cppy_psste() Dim InsertPos As Range Dim lStart As Long NS: On Error Resume Next Set InsertPos = Application.InputBox(Prompt:="Select the cell that you want to start at.", _ Title:="Paste rows", Type:=8) If Not InsertPos Is Nothing Then Application.ScreenUpdating = False Sheets("2").Rows("1:7").Copy InsertPos.Offset(1).Insert Shift:=xlDown Beep If MsgBox("Do you want to paste again?", vbYesNo + vbQuestion, "Paste rows") = vbYes _ Then GoTo NS Application.CutCopyMode = False Application.ScreenUpdating = True End If End Sub Sub cppy_psste2() Dim NumberRow As Long Dim lStart As Long NS: lStart = 0 NumberRow = Application.InputBox(Prompt:="Select the cell that you want to start at.", Title:="Paste rows", Type:=1) If NumberRow = 0 Then Exit Sub On Error Resume Next lStart = Range("A:A").Find(NumberRow).Row + 1 If lStart <> 0 Then Application.ScreenUpdating = False Sheets("2").Rows("1:7").Copy Rows(lStart & ":" & lStart + 6).Insert Shift:=xlDown Beep If MsgBox("Do you want to paste again?", vbYesNo + vbQuestion, "Paste rows") = vbYes Then GoTo NS Application.CutCopyMode = False Application.ScreenUpdating = True Else MsgBox "The value you supplied could not be found!", vbExclamation End If End Sub
The second code is very very well , I prefer to use , But the first the same problem ,when I Select the cell that i want to start at , then I select agree , then " Do you want to paste again ?" I select YES , After this I cant paste again , the mouse wheel do not scroll down .
I greet you, you're a genius
Hello Aiman,
I tested the first macro and I understand that you mean. Sorry about that. It's something I overlooked.
I have fixed this one too (even though you say you prefer macro #2).
Have a great day.
Sub cppy_psste() Dim InsertPos As Range Dim lStart As Long NS: On Error Resume Next Set InsertPos = Application.InputBox(Prompt:="Select the cell that you want to start at.", _ Title:="Paste rows", Type:=8) If Not InsertPos Is Nothing Then Application.ScreenUpdating = False Sheets("2").Rows("1:7").Copy InsertPos.Offset(1).Insert Shift:=xlDown Application.ScreenUpdating = True Beep If MsgBox("Do you want to paste again?", vbYesNo + vbQuestion, "Paste rows") = vbYes _ Then GoTo NS Application.CutCopyMode = False End If End Sub
Excuse me, request a last resort , If I want to copy a single row of sheet and paste more than one row in another sheet based on the row number , I want to copy and paste based on sequence in column A . Please see the attachment
Hi,
Try this code....
Sub cppy_psste2() Dim NumberRow As Long Dim NumberRow1 As Long Dim lStart As Long NS: lStart = 0 NumberRow = Application.InputBox(Prompt:="Enter the row number that you want to start at.", Title:="Start at row", Type:=1) If NumberRow = 0 Then Exit Sub On Error Resume Next lStart = Range("A:A").Find(NumberRow).Row + 1 If lStart <> 0 Then NumberRow1 = Application.InputBox(Prompt:="Enter the number of rows you want to paste", Title:="Paste number of rows", Type:=1) If NumberRow1 = 0 Then Exit Sub Application.ScreenUpdating = False Sheets("2").Rows("10").Copy Rows(lStart & ":" & lStart + NumberRow1 - 1).Insert Shift:=xlDown Rows(lStart & ":" & lStart + NumberRow1 - 1).FormatConditions.Delete Application.CutCopyMode = False Application.ScreenUpdating = True Else MsgBox "The value you supplied could not be found!", vbExclamation End If End Sub
Both of two codes does not work when the sheet has protected .
Last edited by aimanraya; 04-17-2014 at 04:11 AM.
Hi,
You can add a line: Activesheet.Unprotect at the top of the macro.
And a line: Activesheet.Protect at the very bottom of the macro.
Do this for whichever macro you are using (and if the sheet has a password of course).
Sub cppy_psste2() Dim NumberRow As Long Dim NumberRow1 As Long Dim lStart As Long ActiveSheet.Unprotect Password:="pass" 'Change password or comment out password argument if no password is required. NS: lStart = 0 NumberRow = Application.InputBox(Prompt:="Enter the row number that you want to start at.", Title:="Start at row", Type:=1) If NumberRow = 0 Then Exit Sub On Error Resume Next lStart = Range("A:A").Find(NumberRow).Row + 1 If lStart <> 0 Then NumberRow1 = Application.InputBox(Prompt:="Enter the number of rows you want to paste", Title:="Paste number of rows", Type:=1) If NumberRow1 = 0 Then Exit Sub Application.ScreenUpdating = False Sheets("2").Rows("10").Copy Rows(lStart & ":" & lStart + NumberRow1 - 1).Insert Shift:=xlDown Rows(lStart & ":" & lStart + NumberRow1 - 1).FormatConditions.Delete Application.CutCopyMode = False Application.ScreenUpdating = True Else MsgBox "The value you supplied could not be found!", vbExclamation End If ActiveSheet.Protect Password:="pass" 'Change password or comment out password argument if no password is required. End Sub
Fantastic, I tried to the last code , I will try to the others , and tell you .
I am grateful to you, and best wishes to you for success .
Good to know...
Enjoy!
New problem :
The sequence in column A is not values But formulas, and this led to the macro performs based on the row number and not the serial (The sequence) in all codes.
If the column contains formulas, then we need to change the Find command to search for *values* and not the *true* content of the cells.
The following version should work:
Sub cppy_psste2() Dim NumberRow As Long Dim NumberRow1 As Long Dim lStart As Long ActiveSheet.Unprotect Password:="pass" 'Change password or comment out password argument if no password is required. NS: lStart = 0 NumberRow = Application.InputBox(Prompt:="Enter the row number that you want to start at.", Title:="Start at row", Type:=1) If NumberRow = 0 Then Exit Sub On Error Resume Next lStart = Range("A:A").Find(What:=NumberRow, LookIn:=xlValues).Row + 1 If lStart <> 0 Then NumberRow1 = Application.InputBox(Prompt:="Enter the number of rows you want to paste", Title:="Paste number of rows", Type:=1) If NumberRow1 = 0 Then Exit Sub Application.ScreenUpdating = False Sheets("2").Rows("10").Copy Rows(lStart & ":" & lStart + NumberRow1 - 1).Insert Shift:=xlDown Rows(lStart & ":" & lStart + NumberRow1 - 1).FormatConditions.Delete Application.CutCopyMode = False Application.ScreenUpdating = True Else MsgBox "The value you supplied could not be found!", vbExclamation End If ActiveSheet.Protect Password:="pass" 'Change password or comment out password argument if no password is required. End Sub
Thank you very much ,I replaced the old line with this new below line, and all things very good .
lStart = Range("A:A").Find(What:=NumberRow, LookIn:=xlValues).Row + 1
If NumberRow = 0 Then Exit Sub
If NumberRow1 = 0 Then Exit Sub
because of the above two lines , If I do not enter any value "Cancel" , the protection would be canceled , I used Else in the first line instead of Exit Sub , so it is good , but it is difficult to use Else again in the other line .can you modify please ? .
Last edited by aimanraya; 04-22-2014 at 01:42 PM.
Hi,
This will re-enable the protection if you cancel the row number message...
Sub cppy_psste2() Dim NumberRow As Long Dim NumberRow1 As Long Dim lStart As Long ActiveSheet.Unprotect Password:="pass" 'Change password or comment out password argument if no password is required. NS: lStart = 0 NumberRow = Application.InputBox(Prompt:="Enter the row number that you want to start at.", Title:="Start at row", Type:=1) If NumberRow = 0 Then GoTo EH On Error Resume Next lStart = Range("A:A").Find(What:=NumberRow, LookIn:=xlValues).Row + 1 If lStart <> 0 Then NumberRow1 = Application.InputBox(Prompt:="Enter the number of rows you want to paste", Title:="Paste number of rows", Type:=1) If NumberRow1 = 0 Then GoTo EH Application.ScreenUpdating = False Sheets("2").Rows("10").Copy Rows(lStart & ":" & lStart + NumberRow1 - 1).Insert Shift:=xlDown Rows(lStart & ":" & lStart + NumberRow1 - 1).FormatConditions.Delete Application.CutCopyMode = False Application.ScreenUpdating = True Else MsgBox "The value you supplied could not be found!", vbExclamation End If EH: ActiveSheet.Protect Password:="pass" 'Change password or comment out password argument if no password is required. End Sub
Thank you very much for your help, God bless you .
Thank you. It's a pleasure to assist.
There are currently 1 users browsing this thread. (0 members and 1 guests)
Bookmarks