• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Need a macro to copy paste data one by one with user command

sdsurzh

Member
Hi,


I need a code to find out the word from a particular column and paste the particular row to next sheet.


Some conditions to be applied for the above request.

1. Suppose there are 3 matching found it should take the 1st word and copy & paste the entire row to the next sheet and it has to ask the user to run the report or not.

2. If Yes then it should fetch the 2nd matching data and paste in the next sheet and again it should ask the user to run the report or not.

3. If yes then it should fetch the 3rd matching data and paste in the next sheet and again it should ask the user to run the report or not.

4. If yes it should say all the data are updated.

5. If any where NO is selected it should not run the report.


Thanks,

Suresh Kumar S
 
I believe this matches your criteria. Note that there was a lot of info missing, so you'll need to change some stuff at the beginning to match your exact setup.

[pre]
Code:
Sub RunReports()
Dim MyWord As String
Dim xChoice As Variant
Dim SearchRange As Range
Dim FoundCell As Range
Dim StartAdd As String
Dim DestSheet As String

'What column are we looking for
Set SearchRange = Range("A:A")
'What sheet are we pasting to?
DestSheet = "Sheet2"

'What word are we looking for?
MyWord = InputBox("What word do you want to look for?", "Word search")

Set FoundCell = Nothing
Set FoundCell = SearchRange.Find(MyWord)

If FoundCell Is Nothing Then
'Do nothing
Else
'Record the first found cell
StartAdd = FoundCell.Address
With Worksheets(DestSheet)
Do
'Copy and paste to next available row
FoundCell.EntireRow.Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
xChoice = MsgBox("Run report?", vbYesNo, "Prompt")
If xChoice <> vbYes Then Exit Do
Set FoundCell = SearchRange.FindNext(FoundCell)
If FoundCell.Address = StartAdd Then
MsgBox "All data are updated", vbOKOnly
Exit Do
End If
Loop
End With
End If

End Sub
[/pre]
 
Back
Top