Copy and pasting between excel workbooks - vba

I have a Macro that copies and pastes from one excel document to another. For some reason, I had an error when using pastespecial immediately after copying and pasting from the other source doc. So as a workaround I just pasted normally, and then copied it again and then used pastespecial. My problem is that when running this Macro for some reason it adds a space to the end of the numbers turning them into text. Meaning that my graphs don't recognize them.
Workbooks.Open (fileLocation & "/" & fileName & fileType)
Worksheets(sourceWorksheet).Select
rowInUse = 46 'Add data row and name of sheet being imported into
mySheet = "sheet2"
pasteLocation = "D5"
lastColumn = ActiveSheet.Cells(rowInUse, Columns.Count).End(xlToLeft).Column
Range(Cells(rowInUse, firstColumn), Cells(rowInUse, lastColumn)).Copy
ActiveWorkbook.Close SaveChanges:=False
Worksheets(mySheet).Select
Range(tempPasteLocation).Select
ActiveSheet.Paste
Sheets(mySheet).Select
Range(tempPasteLocation, Cells(tempRow, tempColumn + lastColumn)).Select
Selection.Copy
Range(pasteLocation).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range(tempPasteLocation, Cells(tempRow, tempColumn + lastColumn)).Select
Selection.ClearContents
Does anyone have any idea why this is happening or how to fix it?
Thank you

Perform a direct value transfer instead of Copy, PasteSpecial, Values.
Replace,
Sheets(mySheet).Select
Range(tempPasteLocation, Cells(tempRow, tempColumn + lastColumn)).Select
Selection.Copy
Range(pasteLocation).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
With this,
with workSheets(mySheet)
with .Range(tempPasteLocation, .Cells(tempRow, tempColumn + lastColumn))
.Range(pasteLocation).resize(.rows.count, .columns.count) = .value2
end with
end with

Related

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,
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

VBA Copy a row from a Workbook to another

I know this issue has been solved a lot of time, but I can't fix it.
Here is my code :
Sub MàJ_Pluri()
'
' MàJ_Pluri Macro
'
'chemin vers fichier pluri = chemin2
Range("U35").Select
Selection.Copy
Range("U36").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Dim chemin2 As String
chemin2 = Range("U36").Value
Dim chemin As String
Année = Range("C4").Value
Sheets("Création DC").Select
Sheets("Suivi Pluri-annuel").Visible = True
Rows("3:3").Select
Selection.Copy
Workbooks.Open Filename:= _
chemin2 _
, UpdateLinks:=0
'
ActiveSheet.ShowAllData
'
Dim LastRow As Integer
LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
ActiveSheet.Range("$A$2:$AT" & LastRow).AutoFilter Field:=1, Criteria1:=Année
Range("A2").Select
ActiveCell.Offset(2, 0).Select
ActiveCell.EntireRow.Insert
Range("A4").Select
Selection.PasteSpecial Paste:=xlPasteValues
Windows("Gestion DC projet V.2.2.xlsm").Activate
Sheets("Suivi Pluri-annuel").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("Création DC").Select
Range("C2:D2").Select
End Sub
So basicaly, my goal is to open the sheet in the first Workbook, copy what is in the row 3, open the second workbook, insert a blank row beneath the 2nd row, and paste in this row (which is always the 4th). Everything is working except that nothing is copying in the row.
Do you have any ideas ? Help would be really appreciated !
Thank you !
First open workbooks, assign them to variable and then do rest of the operations.
Nothing is copied because you're copying and then opening next workbook, so the copying method is automatically cleared.

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

vba import cells from other workbooks error

I am trying to copy some range of cells from other workbooks, but I get the error:
'runtime '1004' error
Error defined by application or object
if I try to use the "range(cells(i,j), cells(k,h))" sintax instead of the range("A1:Z1"). I.e., In the following code the line "PASTE 1" produces an error, while the line "PASTE 2" runs smoothly (obviously I don't want to use the second one because I need to run a loop over different ranges).
Sub Importa()
Dim directory As String
Dim fileName As String
Dim wbfrom As Workbook
Dim wbto As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
directory = "mydirectory"
fileName = Dir(directory & "*.xl??") 'find the first *.xl?? file; ' wildcards: multiple character (*) single character (?)
Set wbto = ThisWorkbook
Set wbfrom = Workbooks.Open(directory & fileName, False, True)
' copy some cells
wbfrom.Sheets(1).Range(Cells(9, 6), Cells(15, 6)).Copy
'PASTE 1
wbto.Sheets(1).Range(Cells(9, 1), Cells(15, 1)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'PASTE 2
'wbto.Sheets(1).Range("A1:A8").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wbfrom.Close SaveChanges:=False
'Turn on screen updating and displaying alerts again
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
the problem is that you need to qualify the Cells to a particular sheet/workbook. Otherwise, it is implictly belonging to the ActiveSheet, and since the wbFrom is Active at run-time, the range cannot exist (because cells on one worksheet cannot define a range on another worksheet)
Two ways to handle this, one is qualifying Cells like so:
With wbto.Sheets(1)
.Range(.Cells(9, 1), .Cells(15, 1)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
The other is to coerce the address from the cells:
wbto.Sheets(1).Range(Cells(9, 1).Address, Cells(15, 1).Address).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
My preference is for the first option, as it tends to be more dynamic and easy to read and modify later, if you need to do so.

Running a macro on worksheets with a specified name

I am trying to write a macro which pastes over the formulae within certain-named worksheets with their values, thereby making them exportable. I have successfully got the macro to dupe and rename the worksheets, but can't get the copy/paste to run on them as I would like.
Currently my macro copies all visible worksheets except one specified ("Dashboard") and then renames them, replacing " (2)" with "_VARIABLES". So far so good. It is then supposed to overwrite formulae in the newly created worksheets with values; this part does not work.
Here is the entire code:
Private Sub testestssss()
Dim ws As Worksheet
'Copy all visible worksheets except "Dashboard" to the end
For Each ws In Sheets
If ws.Name = "Dashboard" Then
Else
If ws.Visible Then ws.Copy after:=Worksheets(Worksheets.Count)
End If
Next
'Rename all "wk * (2)" sheets to "wk *_VARIABLES"
For Each ws In Sheets
If ws.Name Like "* (2)" Then
ws.Name = Replace(ws.Name, " (2)", "_VARIABLES")
End If
Next
'Overwrite all "wk *_VARIABLES" formulae with values
For Each ws In Sheets
If ws.Name Like "*_VARIABLES" Then
Columns("A:B").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Next
End Sub
So all the above works up until the 'overwrite all "wk *_VARIABLES" formulae with values' part. That appears to be ineffective.
Any help will be gratefully appreciated!
Thank you.
You keep selecting the column of the active sheet. This should do what you expect:
For Each ws In Sheets
If ws.Name Like "*_VARIABLES" Then
ws.Select
Columns("A:B").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Next
Alternatively, you can simply write this (no need to select and it runs a bit faster without them):
For Each ws In Sheets
If ws.Name Like "*_VARIABLES" Then
ws.Columns("A:B").Copy
ws.Columns("A:B").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End If
Next
And finally to save a few keystrokes:
For Each ws In Sheets
If ws.Name Like "*_VARIABLES" Then
With ws.Columns("A:B")
.Copy
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
End If
Next
And don't forget to add the following statement after the copy/paste section:
Application.CutCopyMode = False
to keep things clean.