CopyPaste

I could use some help with the code that I have put together.
The problem I am having is with the copy and paste or really with just the paste.

Here is how things should work:
1. I would open a worksheet and find the Cross Reference information in that sheet that I would like copy.
2. I would then run my code and get a message box saying (Do you want to copy?) (YesNo)
If yes a box will appear saying (Copy Area). I would then select the area on the spreadsheet that I would like
to copy. Select Ok
3. Next another textbox will appear asking me to enter the Cross Ref# that I would like to search for. I enter the
number and the search will begin. The search would be on the active workbook and be asked to search the
directory for other workbooks for the Cross Ref#. This all works fine.

My Issue:

Here is my issue and what I am looking for the code to do.
Every time that the Cross Reference # is found in my search I would like the option to paste the information or not paste the information (Yes/No). But that the search continues till no value is found.
Which means it will continue to search the workbook as well as the active directory opening up workbooks searching for the Cross Ref#
The code works fine in copying the information. As well as searching for the information. It just I cannot get it to paste that information or not paste the information.

I am not a Programmer. So I have been working on this for a long while. Your help would be great!!!
[code]Option Explicit
Sub Copy_2()
Dim ws As Worksheet
Dim rFound As Range
Dim strName As String
Dim doyou As String
Dim docopy$
Dim xArea As Range
Dim eArea As Range
Dim xData As Workbook
Dim xName$, ePath$
Dim fPicker As Object
Dim bsearch$
With Application
' .ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
docopy = MsgBox("Do you want to copy?", vbYesNo)
If docopy = vbYes Then
Set xArea = Application.InputBox(prompt:="Copy Area", title:="Select Range", Type:=8)
Rem any select any worksheet And cell
strName = InputBox("Enter Cross Ref#")
If strName = "" Then Exit Sub
For Each ws In Worksheets
With ws.UsedRange
ActiveWindow.ScrollColumn = 1
ActiveWindow.SmallScroll ToLeft:=1
Set rFound = .Find(what:=strName, After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole)
If Not rFound Is Nothing Then
Application.Goto rFound, True
ActiveWindow.ScrollColumn = 1
ActiveWindow.SmallScroll ToLeft:=1
doyou = MsgBox("Do you want to continue searching?", vbYesNo)
If doyou = vbNo Then Exit Sub

End If
End With
Next ws
MsgBox "Value not found"
End If
doyou = MsgBox("Do you want to Search Directory?", vbYesNo)
If doyou = vbNo Then Exit Sub
Do
Set fPicker = Application.FileDialog(msoFileDialogFolderPicker)
With fPicker
.Show
ePath = .SelectedItems(1) & ""
End With
xName = Dir(ePath & "*.xls*")
Do While Len(xName) > 0
Set xData = Workbooks.Open(ePath & xName)
For Each ws In Worksheets
With ws.UsedRange
ActiveWindow.ScrollColumn = 1
ActiveWindow.SmallScroll ToLeft:=1
Set rFound = .Find(what:=strName, After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole)
If strName = "" Then Exit Sub
If Not rFound Is Nothing Then
Application.Goto rFound, True
ActiveWindow.ScrollColumn = 1
ActiveWindow.SmallScroll ToLeft:=1
doyou = MsgBox("Do you want to continue searching?", vbYesNo)
If doyou = vbNo Then Exit Sub

End If

End With
Next ws
xData.Close False
xName = Dir
Loop
bsearch = MsgBox("Value not found, do you want to search another directory?", vbYesNo)
Loop Until bsearch = vbNo
With Application
' .ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True

End With

MsgBox "Value not found"
End Sub



[/code]
Sign In or Register to comment.

Howdy, Stranger!

It looks like you're new here. If you want to get involved, click one of these buttons!

Categories