Macro error when trying to paste ???

[Closed]
Report
-
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
-
I wrote a macro to search for a value in a different file/workbook, copy the row (if the value is found), then paste it back to the original workbook.

Everything goes great up to the pasting part. I select the cell which contains the value, I run the macro, it asks which file to look at for the value, opens that workbook, finds the value, selects the row, copies, closes. It then switches to the original workbook, selects the row, and then an error pops up:

Run-time erro '1004':
PasteSpecial method of Range class fail

I am using a pastespecial code in this macro, but I cannot for the life of me figure out the issue... I manually copied the row and with pastespecial manually pasted the row with no issue, but the macro will not run... Please help!

this code is as follows:

Sub Search()

' get the reference to the active sheet
Dim theSheet As Worksheet
Set theSheet = ActiveSheet

' get the range of selected cells
Dim theActiveRange As Range
Set theActiveRange = Selection

' ask the user for the workbook to be searched
' ask the user for the workbook to be searched
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Select the Excel file to be searched"
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Excel Files", "*.xl*"
If (.Show = 0) Then ' abort if the user cancels the selection
Exit Sub
End If

' open the selected file
Dim FileName As String
FileName = .SelectedItems(1)
Dim wbB As Workbook
Set wbB = Workbooks.Open(FileName:=FileName, ReadOnly:=True)

End With


' loop through all of the cells in the selected range
Dim theCell As Range
For Each theCell In theActiveRange

' get the value from this cell
Dim theValue As String
theValue = theCell.Value

' search the first sheet for this value
Dim fnd As Range
Set fnd = wbB.Sheets(1).UsedRange.Find(theValue)

If Not fnd Is Nothing Then
fnd.Parent.Activate
fnd.EntireRow.Select
Selection.Copy
ActiveWindow.Close

theCell.Parent.Activate
theCell.EntireRow.Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False


Else
MsgBox "not found."
End If

Next theCell


'wbB.Close SaveChanges:=False

'End Function

End Sub


If anyone can help me, I greatly appreciate it!

1 reply

Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
768
I have not tried it but try instead of

theCell.Parent.Activate
theCell.EntireRow.Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False


theCell.Parent.Activate
theCell.Range(theCell.Row, 1).PasteSpecial