paste entire row problem

[lorenzo79]

dear all ,

i need to find a cell value in another workbook.
when the value in column B is found i than need to paste there the entire row (starting from column A ) of the previous cell but i get an error.
tried different way but still not working .
tks if someone can help

Sub copiaincolla()

Dim foundrange As Range
Dim test1
test1 = ActiveCell.Offset(0, -18)
ActiveCell.EntireRow.Copy
Workbooks.Open Filename:="X:\CargoluxItalia\GROUND OPS\riskregister.xlsx", Ignorereadonlyrecommended:=True
Workbooks("riskregister").Unprotect

Set foundrange = Workbooks("riskregister").Sheets("sheet1").Range("b:b").Find(test1, , xlValues, xlWhole, xlByRows, xlNext, False, False, False)
If Not foundrange Is Nothing Then

Workbooks("riskregister").Sheets("Sheet1").Select
[COLOR=rgb(226, 80, 65)]foundrange.Offset(0, -1).PasteSpecial[/COLOR]

End If
End Sub

 

[Alex Blakenburg]

Please provide a screenshot of the error and what line is highlighted when you click on debug ?

 

[lorenzo79]

now i realised that i get an error only when i protect the sheet and i try to unprotect in the macro , if i unprotect the sheet and remove the line "Workbooks("riskregister").Unprotect than the macro works.
as i still need to keep the sheet protected can you help me to sort it out please ..
in the screenshot in red the error i get when i have the sheet protected.

 

[Alex Blakenburg]

You should only need to unprotect the Sheet not the workbook.
Does your protection have a password ?

I would be expecting something like this:-

Workbooks("riskregister").Sheets("Sheet1").Unprotect "Password"       ' <---- Enter password inside the quotes

 

[lorenzo79]

I only need to protect the sheet.
Protection is with no password…

 

[Alex Blakenburg]

I haven't tested this but try this:-

Sub copiaincolla()

    Dim foundrange As Range
    Dim test1
    Dim wbRReg As Workbook
    Dim shtRReg As Worksheet
   
    test1 = ActiveCell.Offset(0, -18)
    ActiveCell.EntireRow.Copy
    Workbooks.Open Filename:="X:\CargoluxItalia\GROUND OPS\riskregister.xlsx", Ignorereadonlyrecommended:=True
    Set wbRReg = Workbooks("riskregister.xlsx")
    Set shtRiskReg = wbRReg.Worksheets("Sheet1")
    shtRReg.Unprotect
   
    Set foundrange = shtRReg.Range("b:b").Find(test1, , xlValues, xlWhole, xlByRows, xlNext, False, False, False)
    If Not foundrange Is Nothing Then
   
        shtRReg.Select
        foundrange.Offset(0, -1).PasteSpecial
   
    End If

    shtRReg.Protect
End Sub

Also since you are pasting the entire row it might be safer to do something like, instead of using offset -1:

        shtRReg.Range("A" & foundrange.row).PasteSpecial

 

[Alex Blakenburg]

Oops change this

Set shtRiskReg = wbRReg.Worksheets("Sheet1")

to this

Set shtRReg = wbRReg.Worksheets("Sheet1")

 

[lorenzo79]

tks, unfortunately still get the error here attchd

 

[Alex Blakenburg]

What is the error message ?
Add this line before it.

Msgbox shtRReg.Range("A" & foundrange.row).address(0,0,xlA1,1)

and see if it makes sense.

I am login off for the night.

 

[lorenzo79]

Dear Alex,
it works perfectly now .
Many tks for your help ...you saved me !!