Paste Value to selected cell of aother workbook FAILED

[nosense]

Hi there here is my code but i get a error message saing that Method class for PasteSpecial has failed



Sub InsertValues()



'copy

Range("D16").Select
Selection.Copy

'Opens Quality WB

Dim fPath As String, fName As String
Dim wb As Workbook

fPath = "C:\Users\stan.kuncik\Desktop\Stan\"
fName = fPath & "GKN Archimedes - GR Quality Sheet v1"

Set wb = Workbooks.Open(fName)

'Detects next empty cell and pastes rotor name

'find
'
Application.DisplayAlerts = False
Workbooks.Open (fName)
Application.DisplayAlerts = True


Sheets("GR").Select



Range("c13").End(xlDown).Offset(1, 0).Select

ActiveCell.PasteSpecial Paste:=xlPasteValues



ActiveWorkbook.Save





End Sub

[LokeshKumar]

Could you please upload the workbook....so that I will get the same error.

[NeedForExcel]

Hi,

Try this -

Sub InsertValues()

    Range("D16").Copy
    
    Dim fPath As String, fName As String
    Dim wb As Workbook
    
    fPath = "C:\Users\stan.kuncik\Desktop\Stan\"
    fName = fPath & "GKN Archimedes - GR Quality Sheet v1"
    
    Set wb = Workbooks.Open(fName)    
    
    Sheets("GR").Select
    
    Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Select
    
    ActiveCell.PasteSpecial Paste:=xlPasteValues
    
    ActiveWorkbook.Save

End Sub

By the way, the code can certainly be made a bit better.. However, I have just tried to get it working for now..

[nosense]

Thank you for your replies.

I have worked out that the problem occurs only when the workbook thats is to be open by macro is already open.

Any ideas how to fix that so it work also with opened workbook.??
Thanks

[NeedForExcel]

Maybe something like this to check if the Workbook is open!

Sub WBO()
    
    Dim wb As Workbook, Name As String, Counter As Integer
    
    For Each wb In Application.Workbooks
        Name = wb.Name
        
        If Name = "Array.xlsm" Then
            Counter = Counter + 1
        End If
        
    Next wb
    
    If Counter = 0 Then
        Workbooks.Open ("C:\Users\FinIQ\Desktop\Array.xlsm")
    End If
    
End Sub

[nosense]

Maybe something like this to check if the Workbook is open!

Sub WBO()
    
    Dim wb As Workbook, Name As String, Counter As Integer
    
    For Each wb In Application.Workbooks
        Name = wb.Name
        
        If Name = "Array.xlsm" Then
            Counter = Counter + 1
        End If
        
    Next wb
    
    If Counter = 0 Then
        Workbooks.Open ("C:\Users\FinIQ\Desktop\Array.xlsm")
    End If
    
End Sub

i did try to make it to work in that it works for an open file as well but still an error
i did:

code:

Sub InsertValues()
'copy

Range("D16").Select
Selection.Copy
'check if workbook is open
Dim wb As Workbook, Name As String, Counter As Integer

For Each wb In Application.Workbooks
Name = wb.Name

If Name = "GKN Archimedes - GR Quality Sheet v1" Then
Counter = Counter + 1
End If

Next wb

If Counter = 0 Then

Workbooks.Open ("C:\Users\stan.kuncik\Desktop\Stan\GKN Archimedes - GR Quality Sheet v1")

Sheets("GR").Select

Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Select

ActiveCell.PasteSpecial Paste:=xlPasteValues


End If



If Counter <> 0 Then

Workbooks("GKN Archimedes - GR Quality Sheet v1").Activate

Sheets("GR").Select

Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Select

ActiveCell.PasteSpecial Paste:=xlPasteValues


End If
ActiveWorkbook.Save



End Sub

[NeedForExcel]

See if this works

Sub InsertValues()
    
    Dim Counter As Integer
    
    Dim fPath As String, fName As String
    Dim wb As Workbook
    
    fPath = "C:\Users\stan.kuncik\Desktop\Stan\"
    fName = "GKN Archimedes - GR Quality Sheet v1"
    
    Counter = WBO(fName)
    
    If Counter = 0 Then
        Workbooks.Open (fPath & fName)
    Else
        Workbooks(fName).Activate
    End If
        
    Sheets("GR").Select
    
    ThisWorkbook.Worksheets("Sheet1").Range("D16").Copy Cells(Rows.Count, "C").End(xlUp).Offset(1, 0)
    
    ActiveWorkbook.Save

End Sub

Function WBO(fName As String)
    
    Dim wb As Workbook, Name As String, Counter As Integer
    
    For Each wb In Application.Workbooks
        Name = wb.Name
        
        If Name = fName Then
            Counter = Counter + 1
        End If
        
    Next wb
    
    WBO = Counter
    
End Function

Change the sheet name in this line

ThisWorkbook.Worksheets("Sheet1").Range("D16")