I have been trying to remove the .Select from my code because I found out recently it's not really an efficient way to do things, but i can't get this piece of code to work.
The data I am pasting comes from another program so it is on the clipboard
My current code(which works):
Range("A3:A3").Select
ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:= _
False
I have been trying to fix it in two ways, but both give errors.
Option 1:
Worksheets("Orders").Range("A3").PasteSpecial _
Format:="Text", Link:=False, DisplayasIcon:=False
Option 2:
Dim ws As Worksheet
Set ps = Sheets("Orders")
With ps.Range("A3")
.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:= _
False
End With
Both give "application defined or object defined error" so I'm doing something wrong, i just can't figure out where the wrong part is.
Try like this
Dim Ws As Worksheet
Set Ws = Sheets("Orders")
Ws.Range("A3").PasteSpecial xlPasteAll
Updated based on comments
As you are pasting from the clipboard directly, not from another range, you will need the Worksheet.PasteSpecial version, rather than Range.PasteSpecial.
Sub PasteFromClipboard()
'
'code which loads clipboard
'
With Worksheets("Orders")
.Activate 'activate the worksheet so that you can select a range on this sheet
.Range("A3").Select
.PasteSpecial Format:="Text", Link:=False, DisplayasIcon:=False
End With
End Sub
For the first option you forgot the ""
This should work:
Worksheets("Orders").Range("A3").PasteSpecial _
Format:="Text", Link:=False, DisplayasIcon:=False
For the second option change ps in ws as JC Guidicelli said.
try to declare your workbook :
Dim wb As Workbook
Set wb = ThisWorkbook
and after your worksheet :
Dim ws As Worksheet
Set ws = wb.Sheets("Orders")
and past :
ws.Range("a3").PasteSpecial xlValues
Related
I just have started using vba.
Googled for a long time to find an answer.
I have written code for copying cells from one sheet into new one.
I have to do it for every file in a folder.
So I try to use looping. However in a middle of a process error occurs (subscript out of range)
Here is my code that works for one file.
Sub add()
Sheets.add.Name = "Good"
GetBook = ActiveWorkbook.Name
Sheets("Good").Range("A1") = GetBook
Sheets("Report Details").Range("E6:E8").Copy
With Sheets("Good").Range("B1")
.PasteSpecial Paste:=xlPasteValues, Transpose:=True
End With
Sheet2.Activate
Range(Range("A1").End(xlDown), Range("H1").End(xlDown)).Copy
With Sheets("Good").Range("E1")
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
End With
End Sub
Here I try to loop it but it doesn't work, problem occurs here in the first code when looping
With Sheets("Good").Range("E1")
Looping code
FolderPath = "C:\Users\Maxim Osipov\Documents\Mckinsey\BorisT\Project 3(Smart city solutions)\VBA collecting" 'change to suit
If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath + "\"
Filename = Dir(FolderPath & "*.xlsx")
Do While Filename <> ""
Application.ScreenUpdating = False
Set wb = Workbooks.Open(FolderPath & Filename)
'Call a subroutine here to operate on the just-opened workbook
Call add
Filename = Dir
Loop
Application.ScreenUpdating = True
End Sub
Try this slight variation:
Sub add()
'Sheets.add.Name = "Good"
Sheets("Good").Range("A1") = ActiveWorkbook.Name
Sheets("Report Details").Range("E6:E8").Copy
Sheets("Good").Range("B1").PasteSpecial Paste:=xlPasteValues, Transpose:=True
Sheets("Sheet2").Range(Range("A1").End(xlDown).Address, Range("H1").End(xlDown).Address).Copy
Sheets("Good").Range("E1").PasteSpecial Paste:=xlPasteValues
Sheets("Good").Range("E1").PasteSpecial Paste:=xlPasteFormats
End Sub
See also:
Microsoft : Range Object (Excel)
10 ways to reference Excel workbooks and sheets using VBA
MSDN : Refer to Sheets by Name
MSDN : How to Reference Cells and Ranges
MSDN : Range.Copy Method
I was having some trouble figuring out which workbook some of your sheets were in - the ones being opened, or the one being pasted to.
This code will loop through the xlsx files in your folder and copy the ranges to the workbook holding the VBA code.
I added a function to check if the Good worksheet already exists and use that if it does.
Public Sub Main()
Dim FolderPath As String
Dim FileName As String
Dim WB As Workbook
Dim WS As Worksheet
FolderPath = "C:\Users\Maxim Osipov\Documents\Mckinsey\BorisT\Project 3(Smart city solutions)\VBA collecting\"
FileName = Dir(FolderPath & "*.xls*")
Do While FileName <> ""
Set WB = Workbooks.Open(FolderPath & FileName, False, True) 'Not updating links & is read-only.
'You can't create two sheets with the same name,
'so check if it exists first.
If WorkSheetExists("Good") Then
Set WS = ThisWorkbook.Worksheets("Good")
Else
'Add a worksheet to the workbook holding this code.
Set WS = ThisWorkbook.Worksheets.Add
WS.Name = "Good"
End If
'Pass the workbook and worksheet references to the procedure.
Add WB, WS
WB.Close SaveChanges:=False
FileName = Dir
Loop
End Sub
Public Sub Add(WrkBk As Workbook, wrkSht As Worksheet)
Dim LastCell As Range
Dim LastRow As Long
With wrkSht
'Find the last cell.
'You could use "LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row"
'but not sure how much data is in the Sheet2.
Set LastCell = .Cells.Find("*", _
After:=.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
If LastCell Is Nothing Then
LastRow = 1
Else
LastRow = LastCell.Row + 1
End If
.Cells(LastRow, 1) = WrkBk.Name
WrkBk.Worksheets("Report Details").Range("E6:E8").Copy
.Cells(LastRow, 2).PasteSpecial Paste:=xlPasteValues, Transpose:=True
With WrkBk.Worksheets(2)
.Range(.Cells(1, 1), .Cells(.Rows.Count, "H").End(xlUp)).Copy
End With
With .Cells(LastRow, "E")
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
End With
End With
End Sub
Public Function WorkSheetExists(SheetName As String, Optional WrkBk As Workbook) As Boolean
Dim wrkSht As Worksheet
If WrkBk Is Nothing Then
Set WrkBk = ThisWorkbook
End If
On Error Resume Next
Set wrkSht = WrkBk.Worksheets(SheetName)
WorkSheetExists = (Err.Number = 0)
Set wrkSht = Nothing
On Error GoTo 0
End Function
If you can only use the Sheet2 reference in the workbook being opened this function will find it:
Public Function GetWorkSheet(sCodeName As String, Optional wrkBook As Workbook) As Worksheet
Dim wrkSht As Worksheet
If wrkBook Is Nothing Then
Set wrkBook = ThisWorkbook
End If
For Each wrkSht In wrkBook.Worksheets
If wrkSht.CodeName = sCodeName Then
Set GetWorkSheet = wrkSht
Exit For
End If
Next wrkSht
End Function
To use it just change this line at the bottom of the Add procedure:
With WrkBk.Worksheets(2)
to
With GetWorkSheet("Sheet2", WrkBk)
It's best practice (and warmly recommended) not to use Activate/ActiveXXX/Select/Selection pattern and take advantage of fully qualified range reference up to workbook one
so you could refactor your add() sub as follows (explanations in comments):
Option Explicit
Sub add(ws As Worksheet)
Dim repDetRngToCopy As Range, sht2RngToCopy As Range
With ws 'reference passed worksheet
Set repDetRngToCopy = .Parent.Worksheets("Report Details").Range("E6:E8") 'set needed range in "Report Details" worksheet of the same workbook the currently referenced sheet (i.e. the passed one) belongs to
With .Parent.Worksheets(2) 'reference Sheet2 worksheet of the same workbook the currently referenced sheet belongs to
Set sht2RngToCopy = .Range(Range("A1").End(xlDown), .Range("H1").End(xlDown)) 'set needed range in currently referenced sheet (i.e. Sheet2)
End With
'now start filling cells of referenced sheet (i.e. the passed one)
.Range("A1") = .Name
repDetRngToCopy.Copy 'copy from the range previously defined in "Report Details"
.Range("B1").PasteSpecial Paste:=xlPasteValues, Transpose:=True ' paste in currently referenced sheet
sht2RngToCopy.Copy 'copy from the range previously defined in Sheet2
.Range("E1").PasteSpecial Paste:=xlPasteValues + xlPasteFormats 'paste in currently referenced sheet
.Name = "Good" ' name currently referenced sheet
End With
End Sub
and consequently slightly change your "main" sub where you call it as follows:
Do While Filename <> ""
'Call a subroutine here to operate on the just-opened workbook
With Workbooks.Open(FolderPath & Filename) ' open and reference a new workbook
add .Sheets.add ' call add passing it a reference to a new sheet in referenced workbook (i.e. the newly opened one)
.Close True ' close referenced workbook saving changes
End With
Filename = Dir
Loop
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 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.
This should be dead simple but i'm throwing a total blank so far, i've googled around and not found an answer either.
I'm creating a new workbook using VBA and i'd like to save that workbook so that it opens on the last row containing data when the user opens it. This is what i have so far:-
With ActiveWorkbook
'Added a last row selection so the sheet will open at the bottom of the page - Ash 07/04/14
LastRow = Range("A65536").End(xlUp).Select
Rows(ActiveCell.Row).Activate
.SaveAs str_DestFolder & str_File, FileFormat:=xlOpenXMLWorkbook, AccessMode:=xlShared
.Close
End With
Somehow this is failing me, any help would be much appreciated!
You could add the following line, after activating your last row:
ActiveWindow.ScrollRow = ActiveCell.Row
So your full code would be
With ActiveWorkbook
LastRow = Range("A65536").End(xlUp).Select
Rows(ActiveCell.Row).Activate
ActiveWindow.ScrollRow = ActiveCell.Row
.SaveAs str_DestFolder & str_File, FileFormat:=xlOpenXMLWorkbook, AccessMode:=xlShared
.Close
End With
Several suggestions
Code that should be run to set the workbook up for the next open should be run in the BeforeSave or Open Events.
best to run the code to work on a specific sheet automatically (the first sheet in the sample below) rather than rely on it being active.
Excell 2007 and onwards have 1 million rows, so either use Cells(Row.Count,"A").End(xlup) or Find rather than Range("A65536").End(xlup)`.
code for the ThisWorkbook module (runs automatically on save)
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim ws As Worksheet
Set ws = Sheets(1)
Dim rng1 As Range
Set rng1 = ws.Columns("A:A").Find("*", ws.[a1], xlValues, , xlByRows, xlPrevious)
Application.Goto rng1
ActiveWindow.ScrollRow = rng1.Row
End Sub
LastRow = Wb.Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
Wb.Worksheets("Sheet1").Cells(LastRow, 1).Select
With Wb
Application.DisplayAlerts = False
.SaveAs Filename:="YourFilePath", AccessMode:=xlShared
.Close
Application.DisplayAlerts = False
End With
Set Wb = Nothing
Try this...
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