I'm copying values as part of one sub process and pasting value through an update button on userform.
To copy values:
Private Sub Month1_Click()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.AskToUpdateLinks = False
Dim wkb As Workbook
Dim wks As Worksheet
Set wkb = Workbooks.Open("Place on drive")
Set wks = wkb.Sheets("Training1")
wks.Range("Start:Finish").Copy
wkb.Close
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
Application.ScreenUpdating = True
End Sub
To paste values in current sheet:
Private Sub UpdateActuals_Click()
For i = 1 To 12
If Me.Controls("Month" & i).Value = True Then
ThisWorkbook.Sheets("2017 Actuals").Range(i+1, 5).PasteSpecial xlPasteValues
End If
Next i
End Sub
If I replace "i+1, 5" with "B5", it errors with
"PasteSpecial method of Range class failed".
I feel as if values copied in one sub process are not brought to second one, would that be correct?
Also, how do I reduce processing time given that I have 12 months (12 files) in various places that I can't change the location for...
Range usually likes a starting cell and an ending cell. I suggest since you are looking at just one cell that you change .Range to .Cells. If you really want to use a range with RC format, .Range(Cells(row1, col1), Cells(row2, col2)), if you want just one cell then you can make the two parts the same. I have run into problems before using Range and only one cell definition before, either make it .Cells for your target or fill out Range the way I have explained.. Cheers.
Dim 2017actWS AS Worksheet
Set 2017actWS = ThisWorkbook.Worksheets("2017 Actuals")
1)
2017actWS.Cells(i+1, 5).PasteSpecial xlPasteValues
-or-
2)
2017actWS.Range(2017actWS.Cells(i+1, 5), 2017actWS.Cells(i+1,5)).PasteSpecial xlPasteValues
When using Ranges excel will often throw errors if they are not the same size in a copy and paste, you can eliminate that by using a single cell as the starting target of your paste with .Cells
Also I don't see you call your function. You will want your paste close to your copy or you might find things get strange (suggestion: just after your copy).
Edited to be sure there is not worksheeet ambiguity. Thank you Scott C.
Cheers, WWC
Related
So I have produced this code so far, but I cannot get the paste to work.
The idea is run through 190 workbooks and to paste formulas in some cells with constants in others (range H1:Z160) which grade an excel exam. All the formulas and constants paste and work if done manually.
The paste function (labelled) fails with this error:
This is the now updated and corrected code:
Option Explicit
Sub Examnew()
Dim rCell As Range, rRng As Range 'define loop names
Dim wbmaster As Workbook 'name for master workbook
Dim wbtarget As Workbook 'name for student workbook
Set wbmaster = ActiveWorkbook 'set the name for the master
Dim i As Long 'a counter for the result pasteback
With Application '<--|turn off screen & alerts only removed while testing
.ScreenUpdating = False
.EnableEvents = False
End With
i = 1 'Set the counter for result paste back
'Student numbers in cells B3:B136 WARNING SET TO 2 STUDENTS ONLY FOR TEST
'NOTE that st Nums are in col B with a duplicate in col A to collect results.
Set rRng = wbmaster.Sheets("studentlist").Range("B3:B4")
ActiveSheet.DisplayPageBreaks = False '< | turn off page breaks for speed
For Each rCell In rRng '< | loop through "students" range
ActiveSheet.DisplayPageBreaks = False '< | turn off page breaks for speed
'now open Student exam workbook and set to name "wbtarget"
Workbooks.Open ("/Users/michael/Final_V1/" & rCell.Value & ".xlsx")
Set wbtarget = Workbooks(rCell.Value & ".xlsx")
'do copy & paste from Master to Target
wbmaster.Sheets("Answers_Source").Range("h1:z160").Copy
wbtarget.Sheets("ANSWERS").Range("h1:z160").PasteSpecial
Application.CutCopyMode = False 'Clear the copy command
'Now collect the result in cell I4 and paste it back into column B using the rCell
'for that student number matches the st num in col A
wbtarget.Sheets("Answers").Range("I4").Copy
wbmaster.Sheets("studentlist").Range("B" & 2 + i).PasteSpecial xlPasteValues
Application.CutCopyMode = False 'Clear the copy command
'now save and close the student file...
wbtarget.Close (True)
i = i + 1 'increment i for next pasteback
Next rCell '< | next student number
'save the results file
wbmaster.Save
ActiveSheet.DisplayPageBreaks = True '< | turn back on page breaks once all done
'turn screen & alerts back on
With Application
.ScreenUpdating = True: .DisplayAlerts = True
'.DisplayPageBreaks = True
End With
End Sub
Which works perfectly, Thanks guys.
The reason it fails on that line of code is that there is no Paste method for the Range object.
There are 2 ways to copy paste.
1) Send a value to the Destination parameter in the Copy method. You then don't need a Paste command:
wb.Sheets("Answers_Source").Range("h1:z160").Copy _
Destination := wb2.Sheets("Answers").Range("h1:z160")
2) Use the PasteSpecial method on the destination range after copying, which by default pastes everything, like a standard paste.
wb2.Sheets("Answers").Range("h1:z160").PasteSpecial
Then to stop the Marquee (or marching ants) around the cell you copied, finish with Application.CutCopyMode = False
Even though this has been answered, the Range Value property is something that should be included as an option for this question.
If you're only looking to CopyPasteValues, it is probably better to adjust the Range Value Property to be equal to the Source Range Values.
A couple advantages:
No marching ants (Application.CutCopyMode = False).
The screen should not need to flash update/scroll.
Should be faster.
You don't even need to unhide or activate (which you don't with Copying, but people think you do... so I'm listing it!).
So I rebuilt your Macro with the changes, though I didn't make any other changes, so whatever else you fixed, would probably need to be done again. I also included a second macro (TimerMacro) that you can use to time how long it runs (in case you want to test the performance differences). If you're not using any dates, you can use the property Value2 for a very slight speed improvement, although I haven't seen much improvement with this.
Good Luck!
Sub Examnew_NEW()
Dim rCell As Range, rRng As Range 'define loop names
Dim wbmaster As Workbook 'name for master workbook
Dim wbtarget As Workbook 'name for student workbook
Set wbmaster = ActiveWorkbook 'set the name for the master
Dim i As Long 'a counter for the result pasteback
With Application '<--|turn off screen & alerts only removed while testing
.ScreenUpdating = False
.EnableEvents = False
End With
i = 1 'Set the counter for result paste back
'Student numbers in cells B3:B136 WARNING SET TO 2 STUDENTS ONLY FOR TEST
'NOTE that st Nums are in col B with a duplicate in col A to collect results.
Set rRng = wbmaster.Sheets("studentlist").Range("B3:B4")
ActiveSheet.DisplayPageBreaks = False '< | turn off page breaks for speed
For Each rCell In rRng '< | loop through "students" range
ActiveSheet.DisplayPageBreaks = False '< | turn off page breaks for speed
'now open Student exam workbook and set to name "wbtarget"
Workbooks.Open ("/Users/michael/Final_V1/" & rCell.Value & ".xlsx")
Set wbtarget = Workbooks(rCell.Value & ".xlsx")
'do copy & paste from Master to Target
'PGCodeRider CHANGED!!!!!!!!!!!!!!
wbtarget.Sheets("ANSWERS").Range("h1:z160").Value = _
wbmaster.Sheets("Answers_Source").Range("h1:z160").Value
Application.CutCopyMode = False 'Clear the copy command
'Now collect the result in cell I4 and paste it back into column B using the rCell
'for that student number matches the st num in col A
'PGCodeRider CHANGED!!!!!!!!!!!!!!
wbmaster.Sheets("studentlist").Range("B" & 2 + i).Value = _
wbtarget.Sheets("Answers").Range("I4").Value
Application.CutCopyMode = False 'Clear the copy command
'now save and close the student file...
wbtarget.Close (True)
i = i + 1 'increment i for next pasteback
Next rCell '< | next student number
'save the results file
wbmaster.Save
ActiveSheet.DisplayPageBreaks = True '< | turn back on page breaks once all done
'turn screen & alerts back on
With Application
.ScreenUpdating = True: .DisplayAlerts = True
'.DisplayPageBreaks = True
End With
End Sub
Sub timerMACRO()
'Run this if you want to run your macro and then get a timed result
Dim beginTime As Date: beginTime = Now
Call Examnew_NEW
MsgBox DateDiff("S", beginTime, Now) & " seconds."
End Sub
Try removing these With which anyway make no sense in the context.
'do copy from reference "Answers_Source" worksheet
wb.Sheets("Answers_Source").Range("h1:z160").Copy
'now paste the formulas into the student exam workbook
wb2.Sheets("Answers").Range("h1:z160").Paste
Try going to visual basic editor -> tools -> reference. Check the reference that you are using and see if you active all the reference you need. The root cause of this appears to be related to problems mentioned in https://support.microsoft.com/en-ph/help/3025036/cannot-insert-object-error-in-an-activex-custom-office-solution-after and https://blogs.technet.microsoft.com/the_microsoft_excel_support_team_blog/2014/12/
The code below copies data from a specific column and transfers it to another one. For example, if in column A I have data from row 1 to 10 and press the button, then the values from row 1 to 10 will be transferred to i.e. column D. Afterwards, If I change the values in row 5, 7 and 9 in column A and press the button, only the values from row 5, 7 and 9 will be transferred to column D. The reason why the code is like that is because the worksheet has many rows filled with values and I want to be transferred (copy) only the values that have been modified. Otherwise, it will take quite some time.
The code works, but sometimes I get the error The commnand cannot be used on multiple selections. I tried to have a look on the internet to fix it but I couldn't come up with any solutions. Any help will be appreciated!
Note: A user from this community helped me to write the code below a time ago, but I cannot find the link anymore for that.
This code is pasted in the worksheet that I am using:
Option Explicit
Private Sub Worksheet_Change(ByVal target As Range)
Dim creation As Worksheet
Set creation = ActiveSheet
Dim copydata As Range
Set copydata = Application.Intersect(target, creation.Range("A2:A5000", "A" & creation.Rows.Count))
If (Not copydata Is Nothing) Then
If (CopyDataRange Is Nothing) Then
Set CopyDataRange = copydata
Else
Set CopyDataRange = Application.Union(CopyDataRange, copydata)
End If
End If
End Sub
And this code is pasted in a module:
Option Explicit
Public CopyDataRange As Range
Public Sub CommandButton1_Click()
Application.ScreenUpdating = False
If (Not CopyDataRange Is Nothing) Then
CopyDataRange.Copy
CopyDataRange.Offset(0, 3).PasteSpecial Paste:=xlPasteValues ' this where I get the error
Set CopyDataRange = Nothing
End If
Application.ScreenUpdating = True
End Sub
PasteSpecial doesn't work on multiple ranges. You can loop over all parts of the range using the Areas property:
if Not CopyDataRange Is Nothing then
Dim r As Range
For Each r In CopyDataRange.Areas
r.Copy
r.Offset(0, 3).PasteSpecial Paste:=xlPasteValues
Next
set CopyDataRange = nothing
end if
This will work even if you don't have a multiple range, in that case it contains only one Area (Areas.Count = 1)
At this point there are two problems, but the first one i want to deal with is that i cannot get the paste function to work. When I run through the code the specific cells are highlighted to copy (the cell border is b&w flashing) and the cells where they are to end up are now highlighted, but nothing pastes.
Sub OtherTask()
Dim DRng As Range
ActiveSheet.Range("g2:ah2").find(Date).Select
ActiveCell.Resize(5).Offset(5).Select
Selection.AutoFilter field:=1, Criteria1:="1", Operator:=xlFilterValues
Set DRng = ThisWorkbook.ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
DRng.Copy
ActiveSheet.Range("r12").PasteSpecial xlPasteAll
If ActiveSheet.AutoFilterMode = "True" Then
ActiveSheet.AutoFilterMode = "False"
End If
End Sub
I should bring up the second problem. When I execute this from the macro button it performs as per the description above, but when I am in the editor and I press the play button I get error 91 that the object is not set. Not sure why I would get the error with one form of execution and not the other?? Looking through similar perhaps I should be using value instead of copy? Thanks for any help.
I had to make some assumptions with your code because there are some things that are not that clear. The assumptions should be easy to see and to change according to your needs.
Sub OtherTask()
Dim ws as Worksheet
Dim DRng As Range
Set ws = Worksheets("mySheet")
With ws
Dim rFound as Range
Set rFound = .Range("g2:ah2").find(Date)
rFound.Resize(5).Offset(5).AutoFilter field:=1, Criteria1:="1", Operator:=xlFilterValues
'declare this range explicitly, whatever it is
Set DRng = .Range("A1:B5000").AutoFilter.Range.SpecialCells(xlCellTypeVisible)
DRng.Copy .range("R12") 'since you paste everything just do straight from copy method
If .AutoFilterMode = "True" Then .AutoFilterMode = "False"
End With
End Sub
I get an extraction from SAP that usually has 40 tabs. I then need to copy their contents in other tabs across another workbook - my template. This template is made of 40 input tabs. For each input tab there is always an extracted tab which contents I will paste. I have been trying to automate this task with the following code.
Option Explicit
Sub copytabs()
Workbooks("test").Worksheets("sheet1").Range("A1:PPP999").Copy
Workbooks("test2").Worksheets("sheet1").Activate
Range("B2").Select
ActiveSheet.Paste
Workbooks("test").Worksheets("sheet3").Range("A1:PPP999").Copy
Workbooks("test2").Worksheets("sheet3").Activate
Range("B2").Select
ActiveSheet.Paste
Workbooks("test").Worksheets("sheet5").Range("A1:PPP999").Copy
Workbooks("test2").Worksheets("sheet5").Activate
Range("B2").Select
ActiveSheet.Paste
End Sub
This code does the work though very slowly. I tried to work on Array bu not luck.
Does any of you has a suggestion?
Cheers
Fabi
No need to use .Activate and .Select. They make your code slower. You may also want to see How to avoid using Select in Excel VBA macros
Also you can write the above code in a loop if the sheet names are like Sheet1, Sheet2...Sheet40
Option Explicit
Sub copytabs()
Dim wbI As Workbook, wbO As Workbook
Dim i As Long
Set wbI = Workbooks("test")
Set wbO = Workbooks("test2")
Application.ScreenUpdating = False
For i = 1 To 40 Step 2
wbI.Sheets("sheet" & i).Range("A1:PPP999").Copy _
wbO.Sheets("sheet" & i).Range("B2")
DoEvents
Next i
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
BTW creating a copy of workbook test and renaming it to Test2 would be much faster?
EDIT
my extraction has 40 tabs and each of them has a name. For example Praline 1617, Total Company 1617 and so on...Then I paste their contents in tabs named exactly like their original. So my template has the same tabs name of the extraction. – Fabi 1 min ago
Is this what you want?
Option Explicit
Sub copytabs()
Dim wbI As Workbook, wbO As Workbook
Dim ws As Worksheet
Set wbI = Workbooks("test")
Set wbO = Workbooks("test2")
Application.ScreenUpdating = False
For Each ws In wbI.Worksheets
ws.Range("A1:PPP999").Copy wbO.Sheets(ws.Name).Range("B2")
DoEvents
Next ws
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Adjust the For loop indices to match your needs:
Sub copytabs()
For i = 1 To 11 Step 2
Workbooks("test").Worksheets("sheet" & i).Range("A1:PPP999").Copy Workbooks("test2").Worksheets("sheet" & i).Range("B2")
Next i
End Sub
This avoids using Select.
Alternatively, in case the worksheets have specific names and to improve the readability of the code, then use the following code
Sub CopyPaste()
WSName = Array("Sheet1", "Sheet3", "Sheet5")
For n = LBound(WSName) To UBound(WSName)
With Workbooks("test").Worksheets(WSName(n)).Range("A1:PPP999")
.Copy Workbooks("test2").Worksheets(WSName(n)).Range("B2")
End With
Next
End Sub
I'm trying to loop through a range of cells, locking any cell that has content while leaving empty cells unlocked.
When I run the below code the result is the entire sheet is locked. If I add an else statement the sheet is unlocked. Basically whatever the last .locked = (true, false) statement is is how the entire sheet winds up.
Change 1 Is it possible that I have some setting on/off that is interfering since I'm the only one who is unable to get any of this to work?
Sub ProtectTheSheet()
Dim chCell As Range
Dim chRng As Range
'Clear the default status
ActiveSheet.Unprotect
Range("A7:I35").Locked = False
Set chRng = ActiveSheet.Range("A7:I35")
'Check cell value in body and lock cells with content
For Each chCell In chRng.Cells
If chCell.Value <> "" Then Cells.Locked = True
Next chCell
ActiveSheet.Protect
End Sub
Sub ProtectTheSheet()
Dim chCell As Range
Dim chRng As Range
ActiveSheet.Unprotect
Set chRng = ActiveSheet.Range("A7:I35")
'Check cell value in body and lock cells with content
For Each chCell In chRng.Cells
chCell.Locked = (chCell.Value <> "")
Next chCell
ActiveSheet.Protect
End Sub
You can try this.
Public Sub abc()
ActiveSheet.Unprotect Password:="1234"
ActiveSheet.Range("I8:I500, K8:K500, M8:M500, N8:N500").Cells.Locked = False
ActiveSheet.Protect Password:="1234"
End Sub
Check this out: http://www.mrexcel.com/archive/VBA/15950b.html
Sub CellLocker()
Cells.Select
' unlock all the cells
Selection.Locked = false
' next, select the cells (or range) that you want to make read only,
' here I used simply A1
Range("A1").Select
' lock those cells
Selection.Locked = true
' now we need to protect the sheet to restrict access to the cells.
' I protected only the contents you can add whatever you want
ActiveSheet.Protect DrawingObjects:=false, Contents:=true, Scenarios:=false
End Sub
If you say Range("A1").Select, then it locks only A1. You can specify multiple cells to be locked by specifying as follows:
A3:A12,D3:E12,J1:R13,W18
This locks A3 to A12 and D3 to E12 etc.
I may be missing something but...
Cells.Locked = True
...will lock all cells on the active sheet. If you just change it to...
chCell.Locked = True
...then it works; I think?! As the range is very small, you may as well not unlock cells at the start, and instead unlock cells whilst locking them e.g.
For Each chCell In chRng.Cells
If chCell.Value <> "" Then
chCell.Locked = True
Else
chCell.Locked = False
End If
Next chCell
If you are new to VBA, I would recommend cycling through code line-by-line as described in this Excel consultant's video. If you step through code, you can check "has cell A7 behaved as expected?"...instead of just seeing the end product
A quick way to unlock non-blank cells is to use SpecialCells see below.
On my testing this code handles merged cells ok, I think this is what is generating your error on Tim's code when it looks to handle each cell individually (which to be clear is not an issue in Tim's code, it is dealing with an unexpected outcome)
You may also find this article of mine A fast method for determining the unlocked cell range useful
Sub Quicktest()
Dim rng1 As Range
Dim rng2 As Range
On Error Resume Next
Set rng1 = ActiveSheet.Range("A7:I35").Cells.SpecialCells(xlFormulas)
Set rng2 = ActiveSheet.Range("A7:I35").Cells.SpecialCells(xlConstants)
On Error GoTo 0
ActiveSheet.Unprotect
ActiveSheet.Range("A7:I35").Cells.Locked = False
If Not rng1 Is Nothing Then rng1.Cells.Locked = True
If Not rng2 Is Nothing Then rng2.Cells.Locked = True
ActiveSheet.Protect
End Sub
I know this is an old thread, but I've been stuck on this for a while too, and after some testing on Excel 2013 here's what I conclude if your range includes any merged cell
The merged cells must be entirely included within that range (e.g. the merging must be entirely within the range being lock/unlocked
The range being merged can be larger, or at least exactly the range corresponding to the merged cells. If it's a named range that works as well.
Also, you cannot lock/unlock a cell that is already within a protected range. E.g if you run:
public sub test()
Sheet1.range("myNameRange").locked = true
Sheet1.protect
end sub
Twice it will work the first time, and fail the second time around. So you should unprotect the target range (or the sheet) before....
If you want to protect the specific cells of any specific excel without the password protection then here is the solution:
Sub ProtectingSheet()
Workbooks.Open (c\documents\....)
Dim mainworkBook As Workbook
Set mainworkBook = ActiveWorkbook
Worksheets(CellValue).Activate
mainworkBook.Sheets("Sheet1").Range("A1:AA100").Locked = True
Range(Cells(1, 2), Cells(1, 25)).Select
Selection.Locked = False
ActiveSheet.Protect
End Sub