Paste Special error 1004 PasteSpecial method of Range class failed

I have looked thoroughly at the current answers for this problem and none of them have fixed mine.

The operation is simply copying a selection of a sheet and copying to a new book called budget.

Again I have tried multiple different ways of doing the same thing and none of them seem to change this error. The select method works,it only breaks when I try to paste.

Code:

Range("B3").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Dim wk As Workbook Set wk = Workbooks.Add wk.SaveAs FileName:=ThisWorkbook.path & "\" & "Budget.xlsx" wk.Activate wk.Unprotect wk.Worksheets("Sheet1").Range("B3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False 

Thanks,

2 Answers

If you try exactly the steps in the code manually, you will find it also fails. The issue is that inbetween copying the cells and trying to paste them, you are creating a new workbook and saving it. This cancels copy/paste mode (i.e. the "marching ants" around the copied range disappear), so there is nothing to paste.

The solution is to not use Selection at all. In general any time you find yourself writing .Select in VBA you're doing it wrong (see this question for detail). Here is how I would re-write your code:

Dim wk As Workbook Set wk = Workbooks.Add wk.SaveAs Filename:=ThisWorkbook.Path & "\" & "Budget.xlsx" ThisWorkbook.Range("B3").CurrentRegion.Copy wk.Worksheets("Sheet1").Range("B3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False 

Try the code below (explanation inside the code as comments):

Dim wk As Workbook Set wk = Workbooks.Add wk.SaveAs Filename:=ThisWorkbook.Path & "\" & "Budget.xlsx" wk.Activate wk.Unprotect ' have the Copy>>Paste section together Dim LastCol As Long Dim LastRow As Long ' you never mentioned which sheet to copy from, I used the first index With ThisWorkbook.Sheets(1) LastCol = .Range("B3").End(xlToRight).Column LastRow = .Range("B3").End(xlDown).Row .Range("B3", .Cells(LastRow, LastCol)).Copy ' <-- Copy without Select End With ' Paste without Select wk.Worksheets("Sheet1").Range("B3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False