Paste Special error 1004 PasteSpecial method of Range class failed - vba

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,

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

Related

Code Cleanup for Combining Sheets

I do not have much experience with VBA but I will start by explaining my situation.
I have a workbook with 341 sheets. Each sheet is identical in layout in that they occupy the space A1:J48. I need to combine all of these into one sheet called "COMBINATION". The information of relevance is from A10:J48. I also need to have the cells from A1:J9 as they are the title which is shared across all the sheets.
What I did was write a code that copies A1:J48 for Sheet1 (to get the title and info) and pastes it into "COMBINATION" with the paste special as text, then a code that goes to Sheet2 and copies from A10:J48 and pastes it in the first empty cell in column A of "COMBINATION".
This brings me to my problem. I have realized that there must be an easier way of doing this instead of copying the code 339 more times for each of the sheets.
See below the code. It does what I want correctly but as mentioned, I would like to find a way to not do this 339 more times...
Sheets("Sheet1").Select
Range("A1:J48").Select
Selection.Copy
Sheets("COMBINATION").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Columns.AutoFit
Sheets("Sheet2").Select
Range("A10:J10").Select
Range("J10").Activate
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("COMBINATION").Select
NextFree = Range("A10:A" & Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row
Range("A" & NextFree).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
I would use code like the following:
Dim ws As Worksheet
Dim r As Long
'Copy A1:J9 from the first sheet
Worksheets("Sheet1").Range("A1:J9").Copy
WorkSheets("COMBINATION").Range("A1").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
'Now loop through every sheet (except "COMBINATION") copying cells A10:J48
r = 10 ' first sheet will be copied to row 10 in COMBINATION
For Each ws In Worksheets
If ws.Name <> "COMBINATION" Then
ws.Range("A10:J48").Copy
Worksheets("COMBINATION").Range("A" & r).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
'Set pointer ready for next sheet
r = r + 39
End If
Next
'Set column widths
Worksheets("COMBINATION").Columns.AutoFit
If your sheets don't always have data in all 39 rows (10 to 48), replace r = r + 39 with
r = Worksheets("COMBINATION").Range("A" & Worksheets("COMBINATION").Rows.Count).End(xlUp).Row + 1
Put the repeating code into a loop (untested):
Dim i as Integer
For i=2 to 341
Sheets(i).Select
Range("A10:J10").Select
Range("J10").Activate
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("COMBINATION").Select
NextFree = Range("A10:A" & Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row
Range("A" & NextFree).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next i
Range.PasteSpecial xlPasteValues is convenient but slow. It is much faster to define your 'Target' range to be the same size as your source range and do a direct assignment.
Sub CombineData()
Application.ScreenUpdating = False
Dim ws As Worksheet
Dim Target As Range
With Worksheets("COMBINATION")
.Range("A1:J9").Value = Worksheets("Sheet1").Range("A1:J49").Value
For Each ws In Worksheets
If ws.Name <> .Name Then
Set Target = .Range("A" & .Rows.Count).End(xlUp).Offset(1)
Target.Resize(39, 10).Value = ws.Range("A10:J48").Value
End If
Next
End With
Application.ScreenUpdating = True
End Sub

Splitting and Hardcoding worksheets containing pivot tables

I am new to using VBA code. I have a workbook with manually created tables as well as pivot tables. For each worksheet in this book, I want to hard-code the data into a new workbook and save it as the name of the worksheet that is being hard-coded. I have the code below. It is saving each workbook properly, but the contents of the workbook are not correct. It is hard-coding the contents of the first worksheet in my original workbook every time. I've tried to set the next ActiveSheet at the end of the code but it fails. Did I mention I am not a programmer? Please help!
Sub Splitbook()
Dim path As String
Dim dt As String
path = CreateObject("WScript.Shell").specialfolders("Desktop") & "\SLF\ "
Call Shell("explorer.exe" & " " & path, vbNormalFocus)
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
ActiveSheet.UsedRange.Select
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveWorkbook.SaveAs path & ws.Name, Excel.XlFileFormat.xlOpenXMLWorkbook
ActiveWorkbook.Close SaveChanges:=False
Next ws
End Sub
You already have the code looping through the sheets of your workbook so you do not need to copy from the ActiveSheet but from the ws worksheet variable.
You also do not need to use Select to get data copied.
Dim ws As Worksheet
Dim newBook As Workbook
For Each ws In ThisWorkbook.Worksheets
ws.UsedRange.Copy
Set newBook = Workbooks.Add
With newBook.Worksheets(1).Range("A1")
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
newBook.SaveAs Path & ws.Name, Excel.XlFileFormat.xlOpenXMLWorkbook
newBook.Close SaveChanges:=False
Next ws

copy and paste from csv file to excel file

I modified a piece of code that opens a .csv file, copies a selected range and pastes it in a selected cell in an excel worksheet.
I am having trouble selecting the next range in the .csv file to paste in the excel file. It only works for the first range (E2:E25).
I want it to select the next range (B2:B25) from the .csv file, copy/paste, but it only selects from the excel file. How do I fix that? Thanks.
Option Explicit
Sub copy2()
Dim FilesToOpen
Dim wkbAll As Workbook
Dim wkbTemp As Workbook
Dim newSheet As Worksheet
FilesToOpen = Application.GetOpenFilename(Title:="Text Files to Open")
Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen, Format:=4)
wkbTemp.Sheets(1).Cells.copy
Range("E2:E25").Select
Selection.copy
Windows("Petty Cash Form (test).xls").Activate
Range("H10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B2:B25").Select
Selection.copy
Windows("Petty Cash Form (test).xls").Activate
Range("B10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
wkbTemp.Close
End Sub
In your VBA macro add the line: wkbTemp.Sheets(1).Activate (see 'Activate Source Worksheet):
Option Explicit
Sub copy2()
Dim FilesToOpen
Dim wkbAll As Workbook
Dim wkbTemp As Workbook
Dim newSheet As Worksheet
FilesToOpen = Application.GetOpenFilename(Title:="Text Files to Open")
Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen, Format:=4)
wkbTemp.Sheets(1).Cells.copy
Range("E2:E25").Select
Selection.copy
Windows("Petty Cash Form (test).xls").Activate
Range("H10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Activate Source Worksheet
wkbTemp.Sheets(1).Activate
Range("B2:B25").Select
Selection.copy
Windows("Petty Cash Form (test).xls").Activate
Range("B10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
wkbTemp.Close
End Sub
Hope this may help.
This is somewhat of a rudimentary answer but I would suggest following the VBA hierarchy in order to select specific ranges.
workbook.worksheet.range
I think if you defined the worksheets then used
wrktemp.Sheets("sheet name").Range("E2:E25")
I believe this will help in pursuit of your problem

copying each row of an excel workbook to another excel workbook using VBA

I have a input workbook, from which I will copy first row and paste it in another excel workbook (wbET). This I have to do for the number of rows in my input workbook.
I have code for first row. I have to do it for all the rows. can any one help me out
code:
Option Explicit
Dim wbIP As Workbook
Dim wbJT As Workbook
Dim wbET As Workbook
Dim mypathET As String
Dim mypathJT As String
Dim mypathIP As String
Dim vals As Variant
Sub tool()
mypathET = "C:\Documents and Settings\madinenih\Desktop\PremiumCalcutionTool"
mypathJT = "C:\Documents and Settings\madinenih\Desktop\Japancalculationtool"
mypathIP = "C:\Documents and Settings\madinenih\Desktop\A01"
'
'Set wbJT = Workbooks.Open(Filename:=mypathJT)
Set wbIP = Workbooks.Open(Filename:=mypathIP)
wbIP.Activate
'Rows("1:1").Select
'Selection.Copy
wbIP.Sheets("A01").Range("A1:IU1").Copy
Set wbET = Workbooks.Open(Filename:=mypathET)
wbET.Activate
wbET.Sheets("Input file data").Range("A3:IU3").PasteSpecial
'wbET.Activate
Application.Run (wbET.Name & "!run1")
Call Createexcels
wbIP.Activate
'Rows("1:1").Select
'Selection.Copy
wbIP.Sheets("A01").Range("A1:IU1").Copy
Set wbJT = Workbooks.Open(Filename:=mypathJT)
wbJT.Activate
wbJT.Sheets(2).Range("A5:IU5").PasteSpecial
'Application.Run (wbJT.Name & "!run1")
Call openexcel
Call compare
End Sub
Sub Createexcels()
Dim NewBook As Workbook
vals = "test"
Set NewBook = Workbooks.Add
NewBook.SaveAs Filename:=vals
'Workbooks("Whatever.xlsx").Worksheets("output").Range("A1:K10").Copy
'NewBook.Worksheets("Sheet1").Range("A1").PasteSpecial (xlPasteValues)
' NewBook.Worksheets("Sheet1").Activate
wbET.Activate
wbET.Sheets("Calculation").Range("L2:L41").Copy
NewBook.Worksheets("Sheet1").Activate
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
wbET.Activate
wbET.Sheets("Calculation").Range("L44:L61").Select
Application.CutCopyMode = False
Selection.Copy
Windows(vals).Activate
Range("A44").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
wbET.Activate
wbET.Sheets("Calculation").Range("L64:L69").Select
Application.CutCopyMode = False
Selection.Copy
Windows(vals).Activate
Range("A63").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
wbET.Activate
wbET.Sheets("Calculation").Range("L72:L81").Select
Application.CutCopyMode = False
Selection.Copy
Windows(vals).Activate
Range("A70").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("A:A").EntireColumn.AutoFit
NewBook.Save
End Sub
You need to loop through all of the rows in your Input worksheet. To start you need to get the last used row in our input sheet.
' use this in your loop. It looks like you are starting on row 3 of your input sheet.
Dim LastRow as Long
LastRow = Activesheet.Cells(Activesheet.Rows.Count, 2).End(xlUp).Row
Dim i as Long
For i = 3 to LastRow
' Code to copy each row goes here
' You will need to change how you are referencing your range
wbET.Sheets("Input file data").Range("A" & i & ":IU" & i).PasteSpecial
Next i
you need to find the last row and last column
using last row and column as reference, you can make the copy paste method easily

Trying to use Excel VBA to copy/paste rows onto form, saving form in between rows

I have a workbook that serves as source data for another Excel-based form (not a Userform, just a formatted spreadsheet). The source file has anywhere from 2-40 rows of data - starting from row 18 - and each row needs to be copied into the form and saved separately, i.e. 15 rows from the Source file equates to 15 distinct Form files.
Each cell within the row must be copied separately and pasted to specific cells on the Form. The Source form contains Clients and their relevant info. I am trying to use a macro on the Form to automatically pull line items from the Source file, save the Form as the client's name in a specified folder, and continue until a blank row is reached on the Source file. I have some basic VBA experience, but have little knowledge of loops, variables, or functions, which seem to be my best course of action here.
Here's what I have so far. All I've been able to accomplish is the copy/pasting of the first row from the Source file.
Range("B18").Select
Selection.Copy
Windows("Form.xls").Activate
Range("F7:K7").Select
ActiveSheet.Paste
Windows("Source.xls").Activate
Range("C18").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Processing Form.xls").Activate
Range("D8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Source.xls").Activate
Range("D18").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Processing Form.xls").Activate
Range("H29").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Source.xls").Activate
Range("E18").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Processing Form.xls").Activate
Range("E29").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Source.xls").Activate
Range("F18").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Processing Form.xls").Activate
Range("D33").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range(“F7:K7”).Select
Application.CutCopyMode = False
Selection.Copy
ActiveWorkbook.SaveAs
I can't even get my macro to save the Form by the client's name. I also know that my extensive use of "Range" and "Select" will slow my code down to a crawl, I just don't know how to make it more efficient. I've tried using a reference cell to that tells the macro which row of the Source file to copy but haven't had any luck down that road either. Any and all help will be greatly appreciated!
Here's a simple demo:
Note: Not Tested
Option Explicit
Sub CopyToForm()
Dim wbSource As Workbook, wbForm As Workbook
Dim wsSource As Worksheet, wsForm As Worksheet
Dim formpath As String, foldertosavepath as string
Dim lrow As Long, i As Integer
Set wbSource = Thisworkbook '~~> assuming you write your code in Source.xls
Set wsSource = wbSource.Sheets("NameOfYourSheet") '~~> put the source sheet name
'~~> put the path where your form template is saved here
formpath = "C:\Users\Username\FolderName\Processing Form.xls"
'~~> put the path where you want to save individual updated forms.
foldertosavepath = "C:\Users\Username\FolderDestination\"
With wsSource
'~~> get the number of rows with data
lrow = .Range("B" & .Rows.Count).End(xlUp).Row
If lrow < 18 Then Msgbox "No data for transfer": Exit Sub
For i = 18 to lrow
Set wbForm = Workbooks.Open(formpath) '~~> open the form
Set wsForm = wbForm.Sheets("Sheetname") '~~> put the form sheet name
'~~> proceed with the copying
.Range("B" & i).Copy: wsForm.Range("F7:K7").PasteSpecial xlPasteValue
.Range("C" & i).Copy: wsForm.Range("D8").PasteSpecial xlPasteValues
.Range("D" & i).Copy: wsForm.Range("H29").PasteSpecial xlPasteValues
.Range("E" & i).Copy: wsForm.Range("E29").PasteSpecial xlPasteValues
.Range("F" & i).Copy: wsForm.Range("D33").PasteSpecial xlPasteValues
'~~> Save the form using the client name, I assumed it is in B?
wbForm.SaveAs foldertosavepath & .Range("B" & i).Value & ".xls"
wbForm.Close True
Set wbForm = Nothing
Set wsForm = Nothing
Next
End With
End Sub
In above code, I assumed that Form.xls is the same as Processing Form.xls.
This should give you the logic.
I hope this get's you started.
This is not test as I've noted, so if you encounter errors, comment it out.
You are frequently activating the workbooks. that's your code slows down..Below code will work faster
Sub test()
Dim dwb As Workbook
Dim swb As Workbook
Set dwb = Workbooks("Form.xls")
Set swb = Workbooks("Source.xls")
Set awb = Workbooks("Processing Form.xls")
With swb
.ActiveSheet.Range("B18").Copy Destination:=dwb.Sheet1.Range("F7:K7")
.ActiveSheet.Range("C18").Copy Destination:=awb.Sheet1.Range("D8")
.ActiveSheet.Range("D18").Copy Destination:=awb.Sheet1.Range("H29")
.ActiveSheet.Range("e18").Copy Destination:=awb.Sheet1.Range("E29")
.ActiveSheet.Range("F18").Copy Destination:=awb.Sheet1.Range("D33")
End With
End Sub
This might help steer you in the right direction:
Dim i As Long
For i = 1 To 10
With Range("A" & i)
.Copy Workbooks("ToWorkbook.xlsx").Worksheets("Sheet1").Range("B" & i + 9)
.Copy Workbooks("ToAnother.xlsx").Worksheets("Sheet2").Range("C" & i + 8)
.Copy Workbooks("AnotherOne.xlsx").Worksheets("SheetA").Range("D" & i + 2)
End With
Next i
i To 10 is used as a counter to loop through the rows in the source workbook.
For each i, you're taking the range from column A (i.e., with this, do something), copying and pasting it into different cells in different workbooks. In the first round, Range("A1") is being copied into 3 different workbooks at Range("B10"), Range("C9") and Range("D3"), respectively. The next turn, Range("A2") from the source book is going to be copied and pasted into the same destination workbooks from last time, but in Range("B11"), Range("C10") and Range("D4"). It's just a matter of finding the pattern for the different forms you need to paste into.