I have the following simple macro to copy data from a closed worksheet. The code runs fine from the VBA editor but fails with a subscript error when run from Excel via macro. The paste special statement appears to be the issue.
I just can't see where the problem is, can anyone help?
Dim wsMaster As Worksheet
Set wsMaster = Worksheets("Master Data")
Dim lastrow As Long
Dim Files As String
Files = "Download.xlsx"
Dim filepath As String
filepath = "C:\users\ms612533\desktop\"
Application.ScreenUpdating = False
wsMaster.Activate
Cells.Select
Selection.Clear
Workbooks.Open (filepath & Files)
lastrow = Worksheets("Global").UsedRange.Rows.Count
Worksheets("Global").Range("A1:V" & lastrow).Copy _
wsMaster.Range("B1")
Worksheets("Global").Range("CV1:cv" & lastrow).Copy
wsMaster.Range("a1").PasteSpecial (xlValues)**
Application.CutCopyMode = False
ThisWorkbook.Activate
Call CloseAll
Application.ScreenUpdating = True
End Sub
Sub CloseAll()
' Close all but the active workbook
Dim wkbk As Workbook
Application.ScreenUpdating = False
For Each wkbk In Application.Workbooks
If wkbk.Name <> ActiveWorkbook.Name Then
wkbk.Close SaveChanges:=False
End If
Next
Application.ScreenUpdating = True
End Sub
I think there's something wrong with the PasteSpecial line: when I use the macro recorder, I get something like this:
wsMaster.Range("a1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
I think we can ignore the parameters after the first. Then we have this:
wsMaster.Range("a1").PasteSpecial Paste:=xlPasteValues
Note that there are no parens (()) around the arguments: PasteSpecial doesn't return anything so it should be treated like a function. That's probably where the subscript issue is coming from.
Also notice the parameter, which comes from the xlPasteType enum, is a little different from the value you had.
The code appears to work fine when calling the macro from a button, but it doesn't work from a shortcut. I'll put it down to an Excel 'feature' and move on.
Related
I'm having an issue with the PasteSpecial function when working in an embedded excel workbook. The program I am working in is "Promax" which is block diagramming software running in Visio, which has the option to add an embedded excel workbook. I've essentially set up a number of cells in excel so that I can import a bunch of fields into a PDF form.
While working in the embedded workbook I am unable to get this function to give any output into the new excel worksheet. If I save a version of the workbook that is outside of promax, the code runs fine. If I just try to paste instead of paste special the code works fine, but all of the references that I pasted break in the new workbook.
Sub ExporttotxtFile()
Dim wb As Workbook
Dim saveFile As String
Dim WorkRng As Range
On Error Resume Next
Set WorkRng = Sheets("Sheet1").Range("A1:HK2")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wb = Application.Workbooks.Add
WorkRng.Copy
wb.Worksheets(1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
wb.Worksheets(1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
saveFile = Application.GetSaveAsFilename(InitialFileName:="Export", fileFilter:="Text Files (*.txt), *.txt")
wb.SaveAs Filename:=saveFile, FileFormat:=xlText, CreateBackup:=False
wb.Close
Application.CutCopyMode = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Does anyone have a solution to this or another method of getting this done? This code was taken from this: https://www.extendoffice.com/documents/excel/612-excel-export-data-to-text.html
Thanks!
While playing around with this more it seemed like xlPasteFormat was pasting an image over the values rather than formatting. I scrapped the pastespecial method and used a different solution.
wb.Worksheets(1).Paste
wb.Worksheets(1).Range("A1:HK2").Value = WorkRng.Value
I paste everything with the first paste and set the values with the second line so that the formatting stays.
Thanks for the help everyone.
I have written a macro that can successfully loop through a folder, copy and paste the information into a new workbook, and insert three formulas. I'm having problems, though, with the index functions in some macros I call not displaying correctly.
Sub LoopAllExcelFilesInFolder()
Application.ScreenUpdating = False
Dim MyFolder As String
Dim MyFile As String
MyFolder = "C:\Users\myname\Desktop\Test Files"
MyFile = Dir(MyFolder & "\*.xlsx")
'This is where my loop code starts
Do While MyFile <> ""
Workbooks.Open Filename:=MyFolder & "\" & MyFile, UpdateLinks:=0
Sheets("Report").Activate
Sheets("Report").Cells.Select
Application.CutCopyMode = False
Application.DisplayAlerts = False
Selection.Copy
ActiveWorkbook.Close True
Windows("Database Loop Test.xlsm").Activate
Sheets("PORT").Activate
Range("A1").Select
ActiveSheet.Paste
'It is successfully pasted to the desired workbook
'Here I call macros that insert sum, mid, and index functions. Sum and mid work but index doesn't
Call icvba
Call iovba
Call idvba
MyFile = Dir
Loop
End Sub
The weird thing is, when I check the index functions after I run the macro, they are all correct. Instead of showing the correct numbers, it shows up as #N/A. Here is the code for the macros I am calling. The code is the same for all three; only the worksheet is being changed.
Sub icvba()
Worksheets("COMMIT").Activate
Dim source As Worksheet
Dim detntn As Worksheet
Dim EmptyColumn As Long
Dim LastRow As Long
Set source = Sheets("vlookup")
Set detntn = Sheets("COMMIT")
LastColumn = detntn.Cells(1, detntn.Columns.Count).End(xlToLeft).Column
LastRow = Worksheets("COMMIT").Range("A:A").Rows.Count
'This if statement inputs the troublesome index function
If detntn.Range("A2") <> "" Then
EmptyColumn = LastColumn + 1
detntn.Cells(3, EmptyColumn).Formula = "=INDEX(PORT!$S$5:$S$4000,MATCH(COMMIT!$G3,PORT!$G$5:$G$4000,0))"
LastRow = ActiveSheet.UsedRange.Rows.Count
detntn.Cells(3, EmptyColumn).AutoFill destination:=detntn.Range(detntn.Cells(3, EmptyColumn), detntn.Cells(LastRow, EmptyColumn))
End If
'This if statement inputs the mid function
If detntn.Range("A2") <> "" Then
detntn.Cells(2, EmptyColumn).Formula = "=MID(PORT!$A$2,7,50)"
End If
'This if statement inputs a sum function
If detntn.Range("A2") <> "" Then
Worksheets("vlookup").Activate
ActiveSheet.Range("A1").Select
Selection.Copy
Worksheets("COMMIT").Activate
detntn.Cells(1, EmptyColumn).Select
Selection.PasteSpecial Paste:=xlAll
End If
Columns(EmptyColumn).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
End Sub
Additionally, when I call the icvba, iocba, idvba macros individually, they work perfectly. It is only when I call them inside of my loop function that they stop working.
This is the first loop I have written with VBA, so I might be missing something simple. I just can't figure out where I'm going wrong. Any help would be much appreciated!
Sounds like the formulas just haven't calculated - Try putting this just before copying doing the pastespecial at the end:
Not_Calculated:
Application.Wait(Now + TimeValue("0:00:04")) if not
Application.CalculationState = xlDone then goto Not_Calculated
That basically pauses the Macro from going any further for 4 seconds to allow the calculation complete and if it still hasn't wait another 4 seconds
Please help me... this is driving me nuts.
I am trying to copy some data from a CSV but unable to paste it to the destination file that I normally do manually.
The issue I am facing:
-I cannot go back to the destination file's sheet
-Even if I could it would paste as string
-I need the data to be identical from the CSV
MyFile = Application.GetOpenFilename()
ChDir "C:\datafolder\"
Application.Workbooks.Open (MyFile)
Range("A1").CurrentRegion.Select
Selection.copy
ActiveWorkbook.Close savechanges:=False
Application.ScreenUpdating = True
Windows("chickenfeed.xlsm").Activate
ActiveWorkbook.Sheets("Raw Export").Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End sub
You closed the source range before the paste.
Try this and learn the flow...
(Assuming it's "Sheet1" you try to copy data from)
Option Explicit
Sub PasteData()
Dim oSourceWB As Workbook, oTargetWB As Workbook, MyFile As String
MyFile = Application.GetOpenFilename()
ChDir "C:\datafolder\"
On Error Resume Next
Set oSourceWB = Workbooks.Open(Filename:=MyFile, ReadOnly:=True)
Set oTargetWB = Workbooks("chickenfeed.xlsm")
On Error GoTo 0
If Not (oSourceWB Is Nothing And oTargetWB Is Nothing) Then
oSourceWB.Worksheets("Sheet1").Range("A1").CurrentRegion.Copy oTargetWB.Sheets("Raw Export").Range("A1")
oSourceWB.Close SaveChanges:=False
End If
Set oSourceWB = Nothing
Set oTargetWB = Nothing
End Sub
I have been searching for over a hour now and can not find anything that works for this and would appreciate any help at all. I have been using the following code:
Sub copySheet()
Dim srcBook As Workbook
Set srcBook = Application.Workbooks.Open(ThisWorkbook.Path & "\Book1.xlsx")
srcBook.Sheets("Sheet1").Copy After:=ThisWorkbook.Sheets(1)
srcBook.Close False
End Sub
This copies as expected however, in the copied workbook it creates a new sheet "Sheet1(2)" instead of adding this to the existing sheet1. If repeated it creates "Sheet1(3)", "Sheet1(4)", "Sheet1(5)", etc...
I am really stuck with this and cannot find an answer anywhere.
There are two possible tasks at issue here:
Copying a sheet, which your code does successfully
Copying the contents of a sheet, which is also called a Range
It sounds like what you actually want to do is copy a Range to an existing worksheet. Try this instead:
Sub copySheetContents()
Dim srcBook As Workbook
Set srcBook = Application.Workbooks.Open(ThisWorkbook.Path & "\Book1.xlsx")
srcBook.Sheets("Sheet1").UsedRange.Copy
ThisWorkbook.Sheets(1).Cells(1, 1).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
srcBook.Close False
End Sub
Note that the above assumes that your used range in the source workbook starts at cell A1.
If you are trying to just overwrite what is in your current sheet1:
Sub copySheet()
Dim srcBook As Workbook
Set srcBook = Application.Workbooks.Open(ThisWorkbook.Path & "\Book1.xlsx")
srcBook.Sheets("Sheet1").UsedRange.Copy Destination:=ThisWorkbook.Sheets("Sheet1").Cells(1,1)
srcBook.Close False
End Sub
I am using the following function to save a worksheet from a workbook and save it to a separate workbook. However, it is saving the formulas, whereas I would rather just the values end up in the final workbook. How can I modify this so the resultant workbook doesn't contain formulae and just values?
Sub Sheet_SaveAs(FilePath As String, SheetToSave As Worksheet)
Dim wb As Workbook
Set wb = Workbooks.Add(xlWBATWorksheet)
With wb
SheetToSave.Copy After:=.Worksheets(.Worksheets.Count)
Application.DisplayAlerts = False
.Worksheets(1).Delete
Application.DisplayAlerts = True
.SaveAs FilePath
.Close False
End With
End Sub
Using the link kindly provided I tried this, but to no avail:
Sub Sheet_SaveAs(FilePath As String, SheetToSave As Worksheet)
Dim wb As Workbook
Set wb = Workbooks.Add(xlWBATWorksheet)
With wb
SheetToSave.Copy After:=.Worksheets(.Worksheets.Count)
Application.DisplayAlerts = False
.Worksheets(1).Delete
.Worksheets(1).Copy
.Worksheets(1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.DisplayAlerts = True
.SaveAs FilePath
.Close False
End With
End Sub
but I get an error on the pastespecial line??
.Worksheets(1).Copy
This copies the sheet itself and does not relate to PasteSpecial. You could use:
.Worksheets(1).UsedRange.Copy
or similar. For example, Worksheets(1).Cells.Copy.
I assume it should be Worksheets(.Worksheets.Count) though.
In the following I am using SpecialCells to identify only the formulas in the worksheet, and setting rng.Value = rng.Value to convert these to the results of the formulas.
Sub Sheet_SaveAs(FilePath As String, SheetToSave As Worksheet)
Dim wb As Workbook
Dim ws As Worksheet
Dim rngFormulas As Range, rng As Range
Set wb = Workbooks.Add(xlWBATWorksheet)
With wb
SheetToSave.Copy After:=.Worksheets(.Worksheets.Count)
Set ws = .Worksheets(.Worksheets.Count)
Application.DisplayAlerts = False
.Worksheets(1).Delete
Application.DisplayAlerts = True
With ws
Set rngFormulas = ws.Cells.SpecialCells(xlCellTypeFormulas)
For Each rng In rngFormulas
rng.Value = rng.Value
Next rng
End With
.SaveAs FilePath
.Close False
End With
End Sub
You will need to add some error handling code, to handle the case where there are no formulas in the copied worksheet. (Array formulas may also need to be accounted for.)
The easiest way to copy the values is to do it in 2 steps:
Copy the sheet, then replace the formulas with their values
After:
.Worksheets(1).Delete
in your original code, add the lines:
With Range(Worksheets(.Worksheets.Count).UsedRange.Address)
.Value = .Value
End With
The .value=.value is telling excel to replace every value with the value that is currently being displayed, so all formulas will be replaced with their calculated value
Sorry, answer was starting to look a complete mess, so deleted it and started again. I've written this - it appears to work fine when I tested it - you just need an extra line to save any resulting spreadsheet. :)
For Each Cell In ActiveSheet.UsedRange.Cells
Cell.Copy
Cell.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next