I am trying to write macro to copy cells (condition based) from one sheet to another sheet.
When I am running the macro, I got "pasteSpecial method of Range class failed" error.
I tried to solve it. But I could not able to do it.
Sub update_tuning()
Dim tun_num, tun_select, source1, target1 As Range
Dim r, lr As Long
Sheets("Calc").Select
Set tun_num = Range("B2")
If tun_num <> Null Then
Sheets("Calc").Select
Range("C22:BE22").Select
Selection.Copy
End If
Sheets("DATA_Lbf_ft").Select
lr = Sheets("DATA_Lbf_ft").Range("B3:B1803").Count
For r = 3 To lr
If Range("B" & r).Value = tun_num Then
Exit For
End If
Next r
Sheets("DATA_Lbf_ft").Range("B" & r).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Please give your comments to solve it.
There are too many operations between your .Copy and .PasteSpecial. The .CutCopyMode (when you would normally see the blinking border around the copied cell(s) on the worksheet) is cancelled by the other operations.
It would be better to copy and paste after you have made the destination determination.
For r = 3 To lr
If Range("B" & r).Value = tun_num Then
Exit For
End If
Next r
Sheets("Calc").Range("C22:BE22").copy _
destination:=Sheets("DATA_Lbf_ft").Range("B" & r)
If you abandon the original copy operation and use this method, I believe you should get the results you are looking for.
Addendum:
For value only transfer substitute the following for the .Copy Destination:= ... operation.
With Sheets("Calc").Range("C22:BE22")
Sheets("DATA_Lbf_ft").Range("B" & r).Resize(.Rows.Count, .Columns.Count) = .Cells.Value
End With
Related
I am new to VBA and i tried to create i sub that will update (with vlookup and then copy paste) the comments with new comments from another sheet depending on the case status ("Open"). Basically i tried to put together a code that inserts new rows at the end of the table with a vlookup macro.
The main problem is that i do not know how to instruct excel to identify in which cell he should do the lookup and then copy and paste. As in the example below "M528" will not do it as i want to keep the records that are closed as well. I receive daily only the open cases so therefore i don`t want the code to do any vlookups in those cells where the status is "Closed"
Sub ChangesUpdates()
lastRow = Worksheets("CurrentDash").Range("A" & Rows.Count).End(xlUp).Row
For r = 2 To lastRow
If Worksheets("CurrentDash").Range("AS" & r).Value = "Open" Then
Range("M528").Select
Application.CutCopyMode = False
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=VLOOKUP([#[Parent Case Number]],NewData!C[-12]:C,13,0)"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Without changing things too much, you can do most of what you want with
Sub ChangesUpdates()
lastRow = Worksheets("CurrentDash").Range("A" & Rows.Count).End(xlUp).Row
For rw = 2 To lastRow
If Worksheets("CurrentDash").Range("AS" & rw).Value = "Open" Then
With Worksheets("CurrentDash").Range("M" & rw)
.FormulaR1C1 = "=VLOOKUP([#[Parent Case Number]],NewData!C[-12]:C,13,0)"
.Value = .Value ' effectively a paste-values
End With
End If
Next rw
End Sub
There's no cell selection/activation here so the screen won't move to the updates, but it should cycle through the same set as your routine.
There's some remaining question in my mind about how stable the lookup area is, which you should think about.
So I have around 16.000 cells to copy from one column to another one. If I copy paste it, only the first 1000 cells get pasted, the lower i get in the sheet, the less cells get pasted.
I cannot move & replace the column itself aswell since I m getting the error "This can`tbe done on a multiple range selection".
How can I copy all the cells at once? Thanks in advance
So i solved it over a looped vba:
'
' Macro3 Macro
'
' Keyboard Shortcut: Ctrl+ΓΌ
'
For i = 1 To 36430
Range("L" & i).Select
Selection.Copy
Range("M" & i).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next i
End Sub```
I don't understand why you would use a loop here so maybe I'm missing something. Additionally When moving data in vba it's faster to move arrays than to copy/paste the data. e.g. something like this should be faster:
Sub CopySelection()
Dim addr As String, ArrToCopy, TargetCell As String, Rw As Long, Cl As Long
addr = selection.Areas(1).Address(False, False)
ArrToCopy = Sheet1.Range(addr).Value2
TargetCell = InputBox("What is the target StartCell?") 'e.g. B5
Cl = Range(TargetCell).Column
Rw = Range(TargetCell).Row
With Sheet1
.Range(.Cells(Rw, Cl), .Cells(Rw - 1 + UBound(ArrToCopy, 1), Cl - 1 + UBound(ArrToCopy, 2))).Value2 = ArrToCopy
End With
End Sub
hope this helps.
All,
I would greatly appreciate if someone could assist me with my VBA code Macro. I have 2 different Macros and I need to combine them AND alter one.
Im inserting a row via Excel at the bottom of the Table ABOVE my "Total Row". That works fine!!!
Sub InsertingRow()
Range("A" & Rows.Count).End(xlUp).Select
ActiveCell.EntireRow.Insert
End Sub
Then:
Sub Macro1()
'
' Macro1 Macro
'
'
Range("F12:O12").Select
Selection.Copy
Range("F13").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
**I need to combine the 2 Macros, but I need the PasteSpecial Macro to increment down with the Insert Row Macro and keep the specific columns/cells its copying too as well.
I have a "Total Row" so I need it to push the Total row down and insert/copy in the one above it.
Im sure this is easy.**
Thanks for all the replies.
Something like this should get you on the right track. I am not sure where your data needs to be copied from but give this a try and you will see how it works.
Sub Test()
Dim lastRow As Integer
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Rows(lastRow).Insert
Range("F" & lastRow - 1 & ":O" & lastRow - 1).Copy
Range("F" & lastRow).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
I have a mix of codes I found that seemed to work but no longer does after changing a few things. I am trying to copy values from a range on one sheet ("Sheet1") and paste them transposed onto another ("Sheet2"). The catch is that I only want to paste them into the row that the value in column A equals the value in ("B2") on the same sheet. Also, this value will be repeated throughout column A, but I only need it to paste to the row between rows 11 and 29. Here is what I have so far:
Sub PasteData()
Range("O3:O44").Select
Selection.copy
Worksheets("Sheet2").Activate
Worksheets("Sheet2").Unprotect ("Password")
Dim nRow As Long
Dim nStart As Long, nEnd As Long
For nRow = 11 To 29
If Range("A" & nRow).Value = Range("b2").Value Then
nStart = nRow
Exit For
End If
Next nRow
For nRow = nStart To 29
If Range("a" & nRow).Value <> Range("b2").Value Then
nEnd = nRow
Exit For
End If
Next nRow
nEnd = nEnd - 1
Range("A" & nStart & ":AP" & nEnd).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Worksheets("Sheet2").Protect Password:="Password", DrawingObjects:=True, Contents:=True, Scenarios:=False
Worksheets("Sheet3").Activate
Range("B13").Select
End Sub
I have noticed on your code that you have not referenced the sheet of Range("O3:O44"). So when you run the code, it will Select and Copy the Range("O3:O44")of the active sheet.
To avoid this confusion, avoid using .Select and .Activate as much as possible especially when dealing with multiple sheets. When referencing Ranges, always include the sheet you are targeting to.
So instead of:
Range("O3:O44").Select
Selection.Copy
Do it like this:
Worksheets("Sheet1").Range("O3:O44").Copy
Now to answer your problem, you need to indicate what sheet Range("O3:O44") is from.
Then move this code on the line just before pasting it.
'range to copy with sheet reference
Worksheets("Sheet1").Range("O3:O44").Copy
'range where previous range will be pasted, also with sheet reference
Worksheets("Sheet2").Range("A" & nStart & ":AP" & nEnd).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Upon trying your code, this is the solution to the error you encounter.
I am trying to copy the same row of information from a sheet called "Report" (numbers will change), and paste the values into a sheet "Data" that has headers in the first row.
I tried piecing together some code from various questions.
Here is my code:
Sub Insert_Data()
'
' Insert_Data Macro
Sheets("Report").Range("B9:F9").Copy
Sheets("Data").Range("A1").PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Sub PSData_Transfer()
Sheets("Report").Range("B9:F9").Copy
Dim lastrow As Long
lastrow = Sheets("Data").Range("A65536").End(xlUp).Row
Sheets("Data").Activate
Cells(lastrow + 1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub
You may have to modify this a little bit to work with your code, but feel free to use mine that I'm using in my current worksheet and it works perfect!
Sub Insert_Data()
For R = LR To 2 Step -1 ' Change the 2 in "To 2" to the row just below your header,
' but typically row 2 is the second cell under header anyways
Call CopyTo(Worksheets(2).Range("B" & R & ":C" & R), Worksheets(1)Range("A:B"))
Next R
End Sub
Private Function CopyTo(rngSource As Range, rngDest As Range)
LR = rngDest.cells(Rows.Count, 1).End(xlUp).row
rngDest.cells(LR + 1, 1).value = rngSource.cells(1, 1).value
rngDest.cells(LR + 1, 2).value = rngSource.cells(1, 2).value
End Function
I don't like to use the copy method as it's slow and it likes to copy all the extra jargin, where as getting the value is much faster and it's retrieving ONLY the value