VBA/Paste Special Error

[McDan1el]

Hi Guys,

Trying to build a form where on it selects the data entry row of "d7" until it detects a blank and copy and paste that into a "log" sheet. It then checks for the next blank row and will paste - when the code runs it proves runtime error 1004 which says something about the paste range? If i "end" the debug and rerun the macro to paste and apply it works fine?!

This is the segment the debugger highlights from below:

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


ActiveSheet.Unprotect

Range("D7").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("Log").Select
ActiveSheet.Unprotect
Range("B65536").Select
Selection.End(xlUp).Select
Selection.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("I65536").Select
Selection.End(xlUp).Select
Selection.Offset(1, 0).Select
Selection = Application.UserName
Range("A1").Select
ActiveSheet.Protect
Sheets("Entry Sheet").Select
Application.CutCopyMode = False
Range("D7").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.ClearContents
Range("D7").Select

ActiveSheet.Protect




Many Thanks

 

[Andrew Poulsom]

What is the exact text of the error message? Do you have any merged cells in the copy or paste ranges? They are likely to cause problems

 

[njimack]

There's a lot of unecessary selecting of cells in your code, although can't see anything wrong with the line being highlighted by the debugger. Try the following:

Sub TEST()

Application.ScreenUpdating = False

With Sheets("Entry Sheet")
    .Unprotect
    Range(.Cells(7, 4), .Cells(7, 4)).End(xlToRight).Copy
End With
    
With Sheets("Log")
    .Unprotect
    .Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlValues
    .Range("I" & Rows.Count).End(xlUp).Offset(1, 0) = Application.UserName
    .Protect
End With

Sheets("Entry Sheet").Range(Cells(7, 4), Cells(7, 4)).End(xlToRight).ClearContents

Application.ScreenUpdating = True

End Sub

 

[wilcowoods]

I haven't gone through your code thoroughly (can't see any "If constructions though to detect whether the cell is blank or not!) - BUT if it works how you want it to by ignoring the bug, haveyou tried inserting, "On Error Resume Next" at the beginning?

This is not good programming but it may work as a band-aid! For a more complete solution are you able to a section of the sheets you are copying and pasting to?

 

[RoryA]

Try this:

    Dim wksEntry As Worksheet, wksLog As Worksheet
    Dim lngRow As Long
    Dim rngCopy As Range
    
    Set wksEntry = Sheets("Entry sheet")
    Set wksLog = Sheets("Log")
    
    With wksEntry
        .Unprotect
        ' get range to copy
        Set rngCopy = .Range("D7", .Range("D7").End(xlToRight))
    End With
    rngCopy.Copy
    With wksLog
        .Unprotect
        ' get next empty row in column B
        lngRow = .Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0).Row
        ' paste to B
        .Cells(lngRow, "B").PasteSpecial Paste:=xlPasteValues, _
                                        Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        ' enter username in I on same row
        .Cells(lngRow, "I").Value = Application.UserName
        .Protect
    End With
    ' empty clipboard
    Application.CutCopyMode = False
    ' clear copied range
    rngCopy.ClearContents

    wksEntry.Protect

 

[McDan1el]

Try this:

    Dim wksEntry As Worksheet, wksLog As Worksheet
    Dim lngRow As Long
    Dim rngCopy As Range
    
    Set wksEntry = Sheets("Entry sheet")
    Set wksLog = Sheets("Log")
    
    With wksEntry
        .Unprotect
        ' get range to copy
        Set rngCopy = .Range("D7", .Range("D7").End(xlToRight))
    End With
    rngCopy.Copy
    With wksLog
        .Unprotect
        ' get next empty row in column B
        lngRow = .Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0).Row
        ' paste to B
        .Cells(lngRow, "B").PasteSpecial Paste:=xlPasteValues, _
                                        Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        ' enter username in I on same row
        .Cells(lngRow, "I").Value = Application.UserName
        .Protect
    End With
    ' empty clipboard
    Application.CutCopyMode = False
    ' clear copied range
    rngCopy.ClearContents

    wksEntry.Protect

This appeared to work - but again I need to press END on the below and re-run then it works - as soon as i enter more data to "add" another record the same thing...

Run-time error "1004":

PasteSpecial method of Range class failed

 

[RoryA]

What is the exact error message, and do you have any merged cells?

 

[McDan1el]

What is the exact error message, and do you have any merged cells?

The exact error message is as put above:

Run-time error "1004":

PasteSpecial method of Range class failed

There are no merged cells

 

[Andrew Poulsom]

The Unprotect method clears the clipboard. So do that before you copy/paste.

 

[RoryA]

Good spot, Andrew.
Revised code:

    Dim wksEntry As Worksheet, wksLog As Worksheet
    Dim lngRow As Long
    Dim rngCopy As Range
    
    Set wksEntry = Sheets("Entry sheet")
    Set wksLog = Sheets("Log")
    
    With wksEntry
        .Unprotect
        ' get range to copy
        Set rngCopy = .Range("D7", .Range("D7").End(xlToRight))
    End With

    With wksLog
        .Unprotect
        rngCopy.Copy
        ' get next empty row in column B
        lngRow = .Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0).Row
        ' paste to B
        .Cells(lngRow, "B").PasteSpecial Paste:=xlPasteValues, _
                                        Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        ' enter username in I on same row
        .Cells(lngRow, "I").Value = Application.UserName
        .Protect
    End With
    ' empty clipboard
    Application.CutCopyMode = False
    ' clear copied range
    rngCopy.ClearContents

    wksEntry.Protect