ExcelBanter - Open workbook and paste formulas in another

You have your .copy inside an If statement. Are you sure that you're copying
something?

Another possible problem. When you close a workbook that's had something
copied, you'll get a prompt asking if the clipboard has been cleared.

Maybe the clipboard has been cleared in your code????

This compiled, but I didn't create a test environment:
Option Explicit
Sub PW_OpenFormula()
Application.ScreenUpdating = False

Dim Wb2 As Workbook
Dim Wk1 As Worksheet
Dim Intx As Long
Dim lngRow As Long
Dim RngToCopy As Range

Set Wk1 = ActiveSheet
Wk1.Name = "TargetRenewal"

Set Wb2 = Workbooks.Open("C:\target rent\parkwillows\pw_Formula.xls")

With ActiveSheet 'wb2.worksheets("sheet1")????
Set RngToCopy = Nothing
'shouldn't be the lastrow in the activesheet
lngRow = .Cells.SpecialCells(xlLastCell).Row
For Intx = 1 To lngRow
If InStr(1, .Cells(Intx, 1).Value, " Target Renewal") 0 Then
Set RngToCopy = .Range(.Cells(Intx, 6), .Cells(Intx, 21))
Exit For 'added
End If
Next Intx
End With

With Wk1
lngRow = .Cells.SpecialCells(xlLastCell).Row
For Intx = 1 To lngRow
If InStr(1, .Cells(Intx, 1).Value, " Target Renewal") 0 Then
If RngToCopy Is Nothing Then
MsgBox "nothing to copy"
Else
RngToCopy.Copy
.Cells(Intx, 6).PasteSpecial Paste:=xlFormulas, _
Operation:=xlNone, SkipBlanks:=False,
Transpose:=False
End If
Exit For '????
End If
Next Intx
End With
Wb2.Close savechanges:=False
Application.ScreenUpdating = True
End Sub

TR wrote:

Hello,
I am having trouble pasting formulas from an another workbook into a
main workbook.

I am trying to look for the row with 'Target Renewal'in the first
sheet and then retrieve the formulas within that row. I then want to
take these formulas and copy them into another workbook that has the
same information.

I get an error with this code. I get 'PasteSpecial of Range Class
failed'.

Please help. I am very desperate at this point.

Thanks

Sub PW_OpenFormula()
Dim Wb1 As Workbook
Dim Wb2 As Workbook
Dim Wk1 As Worksheet
Dim Intx As Integer
Dim lngRow As Long
Dim lastrow As Long

ActiveCell.SpecialCells(xlLastCell).Select
lngRow = ActiveCell.Row 'lastcell in spreadsheet
lastrow = 1750

Application.ScreenUpdating = False
Set Wb1 = ActiveWorkbook
Set Wk1 = ActiveSheet
Wk1.Name = "TargetRenewal"
Set Wb2 = Workbooks.Open("C:\target rent\parkwillows\pw_Formula.xls")

For Intx = 1 To lngRow
Cells(Intx, 1).Select
If InStr(1, ActiveCell.Value, " Target Renewal") 0
Then
Range(Cells(Intx, 6), Cells(Intx, 21)).Select
Selection.Copy
End If
Next
Wb2.Close False

With ActiveSheet
For Intx = 1 To lngRow
Cells(Intx, 1).Select
If InStr(1, ActiveCell.Value, " Target Renewal") 0
Then
Range(Cells(Intx, 6), Cells(Intx, 21)).Select
Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False

End If
Next
End With
Application.ScreenUpdating = True
End Sub

--

Dave Peterson