I want to paste link from one sheet to another
Range("A1:D1").Select
Range("D1").Activate
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.Paste Link:=True
However, the code would make the sheet to switch to Sheet2 from Sheet1. Is there anyway that I could paste the link without switching the sheet?
Thanks.
This will work:
ThisWorkbook.Worksheets("Sheet2").Range("D1").Formula = "=Sheet1!D1"
I guess this is what you are trying?
Sub Sample()
Dim i As Long
For i = 1 To 4
Sheets("Sheet2").Cells(1, i).Formula = "=Sheet1!" & _
Split(Cells(, i).Address, "$")(1) & "1"
Next i
End Sub
This code will do the same as your code snippet without changing the active sheet.
Range("A1:D1").Copy
Worksheets("Sheet2").Paste Link:=True
Note that this (and your code) will copy from the active sheet. If you want to copy from a sheet other than the active sheet, use somthing like
Worksheets("Sheet1").Range("A1:D1").Copy
Worksheets("Sheet2").Paste Link:=True
I've had the same problem just now. I just realized then that TightVNC was connected to another machine when I tried to run my code. When I closed it, the code run as usual.
Possibly this happens because some software might be taking control of your clipboard. Just close anything you don't need, like VNCs or Virtual Machines.
Your LINK desire cannot be done without selecting the sheet. But you can make the fact that it does that invisible to the eye.
Option Explicit
Sub test()
Application.ScreenUpdating = False
Sheets("Sheet1").Range("A1:D1").Copy
With Sheets("Sheet2")
.Activate
.Range("A1").Select
ActiveSheet.Paste Link:=True
End With
Sheets("Sheet1").Activate
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
You could use Application.ScreenUpdating = False and then return it to true after the paste has completed.
Example:
Application.ScreenUpdating = False
Worksheets("Sheet1").Range("D1").Copy
Worksheets("Sheet2").Activate
Range("Range You Want To Paste").Select
ActiveSheet.PasteSpecial Link:=True
Worksheets("Sheet1").Activate
Range("A Range You Want Active").Activate
Application.ScreenUpdating =true
Related
hope all is well!
I posted this question on MrExcel, but thought it might gain more traction here.
I had an issue where I needed to filter the highest value, given a set.
That set was defined by rows equaling each other. For any given lat/long/timestamp I am given up to five values.
I have used a function to identify which item in each set has the highest value. This works.
The function is:
=IF(F13=MAX(IF($A:$A=A13, $F:$F)), "Yes", "No")
I would like to open each file, then run the script. So, I wrote a VBA to automate it. It worked initially, then started to freeze my unit.
I am not sure why.
I pasted a link to a test file below:
CSV Test File But also used screenshots to provide insights without downloading a file.
Notice the exact same timestamps, for each one I want the highest value.
When pressing F8 and stepping through the code, I will have the following:
Which is correct, but when I run this as a script (without stepping) the CSV file flashes infinitely.
Any help would be greatly appreciated. Code is shown below.
Sub FilterRSRP_From_CSV()
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'switching off the alert button
ActiveSheet.Name = "OriginalData"
Range("I8").Select
Selection.FormulaArray = "=IF(RC[-3]=MAX(IF(C1=RC[-8], C6)), ""Yes"", ""No"")"
Selection.AutoFill Destination:=Range("I8:I30000"), Type:=xlFillDefault
Range("I8:I30000").Select
Columns("I:I").Select
Selection.AutoFilter
ActiveSheet.Range("$I$1:$I$30000").AutoFilter Field:=1, Criteria1:="Yes"
Cells.Select
Range("L19").Activate
Selection.Copy
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "FilteredData"
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("I:I").Select
Selection.Delete Shift:=xlToLeft
Worksheets("OriginalData").Delete
ActiveWorkbook.Save
Workbooks.Close
I have cleaned up your code for you to remove the selects and turn the lights back on at the end.
Where are you running this from? A personal macro workbook or a host book? You may get an alert at the end as you are bulk closing workbooks, you would be better to specify the books, set their .Saved property to true then close them and it will surpress the alert.
Sub FilterRSRP_From_CSV()
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'switching off the alert button
ActiveSheet.Name = "OriginalData"
Range("I8").FormulaArray = "=IF(RC[-3]=MAX(IF(C1=RC[-8], C6)), ""Yes"", ""No"")"
Range("I8").AutoFill Destination:=Range("I8:I30000"), Type:=xlFillDefault
Columns("I:I").AutoFilter
ActiveSheet.Range("$I$1:$I$30000").AutoFilter Field:=1, Criteria1:="Yes"
Cells.Copy
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "FilteredData"
ActiveSheet.Paste
Columns("I:I").Delete Shift:=xlToLeft
Worksheets("OriginalData").Delete
ActiveWorkbook.Save
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Workbooks.Close
End Sub
Also what is the "alert" button you are trying to avoid with turning displayalerts off, if it is just the save then we can get around that as I explained above and not need to blanket surpress all alerts from Excel.
I recorded a macro to better understand my process. This macro is shown below in the first part. The second part is my attempt to make this thing faster.
Current Sequence of Events
Insert asset name in cell D3, in a tab titled "Live" (cell D3 is a dropdown list with 50+ assets - more on this in next section titled "Steps We Can Improve")
Calculate new asset by using Application.CalculateFull
Wait until the "Live" tab is done calculating to move to next line of code
Wait 15 seconds (more on this in next section)
Copy the newly iterated data in the "Live" tab
Create a new worksheet titled with the asset's name
Paste the data from the "Live" tab as values into the newly created worksheet
Repeat steps 1-7 until all assets have been calculated
Steps to Improve
instead of inserting an asset name in cell D3, which requires a lot of code, I would like to loop through the list found within cell D3 (a data validation list which sources asset names from a master list on another worksheet).
I added time to the code because I thought the model was not fully iterating for certain assets. This was wrong - it never iterated correctly with the addition of time. So, it is likely a formula error? The formula is listed below, and it is showing a #VALUE error for roughly 20 assets - but only when I run the macro. Outside of the macro, this formula populates correctly.
Sub SlowMACROv3()
' Turns off screen updating and auto calcs which helps to speed macro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' Turns off screen updating and auto calcs which helps to speed macro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Sheets("Live").Select
Range("D3").Select
ActiveCell.FormulaR1C1 = "309"
Application.Calculate
If Not Application.CalculationState = xlDone Then DoEvents
Application.Wait (Now + TimeValue("0:00:15"))
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Live").Select
Sheets("Live").Copy Before:=Sheets(1)
Range("D3").Select
ActiveCell.FormulaR1C1 = "310"
Application.Calculate
If Not Application.CalculationState = xlDone Then DoEvents
Application.Wait (Now + TimeValue("0:00:15"))
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
' Turns on screen updating and auto calcs
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
My second attempt works, but the code is just as long. Also a formula throws an error for some assets and can be found at the very bottom.
Sub SlowishMACROv1()
' Turns off screen updating and auto calcs which helps to speed macro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' Cycle all assets and create new worksheets as values macro
Sheets("Live").Copy Before:=Sheets(1)
Range("D3").FormulaR1C1 = "309"
Application.Calculate
If Not Application.CalculationState = xlDone Then DoEvents
Range("A1:XFD1000").Value = Range("A1:XFD1000").Value
Sheets("Live").Copy Before:=Sheets(1)
Range("D3").FormulaR1C1 = "310"
Application.Calculate
If Not Application.CalculationState = xlDone Then DoEvents
Range("A1:XFD1000").Value = Range("A1:XFD1000").Value
' Turns on screen updating and auto calcs
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Formula: =+IF(INDEX('Reversion Dashboard'!$I:$I,MATCH($D$3,'Reversion Dashboard'!$C:$C,0))=1,I331*(1+(RATE($E$325,,$I331,-('Reversion Schedule'!$K$19)))),"")
This formula works in the "Live" tab except for assets that trigger the =1 portion within the IF True section, whenever the macro is run. Why does this formula work every time we switch to a different asset, but not when I run the macro?
Am tempted to suggest you close this question and start again as the comments are long. Read [ask] and [mcve] and perhaps post a screenshot as remember that none of us know anything about your set up.
However, see if this code broadly does what you want - it's not entirely clear as Ibo says.
Sub x()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim r As Range, ws As Worksheet
For Each r In Worksheets("Asset Dashboard").Range("C6:C570") 'go through each cell in DV list
If Len(r) > 0 Then 'only do something if cell not empty
Worksheets("Live").Range("D3").Value = r.Value 'transfer value to D3 of Live
Application.Calculate
Set ws = Worksheets.Add 'add new sheet
Worksheets("Live").UsedRange.Copy
ws.Range("A1").PasteSpecial xlValues 'copy values only from Live to new sheet
End if
Next r
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
I want to edit this macro to overwrite previous data in another workbook without prompting. See attached code. Any help would be greatly appreciated.
Sub AV()
Workbooks.Open Filename:="T:\Cleveland\Avon\Monthly Sales\Monthly Sales 2018.xls"
Windows("Sales_By_Day_Location Analysis.xlsm").Activate
Sheets("AV").Select
Range("A1:AC88").Copy
Windows("Monthly Sales 2018.xls").Activate
Sheets("Avon").Select
Range("A1:D1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False 'esp
End Sub
As per comments from John, and after tidying up your code a little, I believe something like the code below would do what you are expecting:
Sub AV()
Application.DisplayAlerts = False
Workbooks.Open Filename:="T:\Cleveland\Avon\Monthly Sales\Monthly Sales 2018.xls"
Workbook("Sales_By_Day_Location Analysis.xlsm").Worksheets("AV").Range("A1:AC88").Copy
Workbook("Monthly Sales 2018.xls").Sheets("Avon").Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False 'esp
Application.DisplayAlerts = True
End Sub
You should attempt not to use Activate or Select statements. Also your copy range is a lot bigger than your paste range, so for the purpose of this answer I've changed the paste range to A1.
If you want to then save the workbooks and close it without a prompt, you could do something like:
Workbook("Monthly Sales 2018.xls").Close SaveChanges:=True
I have a checkbox which copies 5 cells of a address into 5 cells below if the project address is the same as the correspondence address.
here is the code I have:
Sub copy_address()
'
' copy_address Macro
'
Range("D5:G5").Select
Selection.Copy
Range("D11:G11").Select
ActiveSheet.Paste
Range("D6:G6").Select
Application.CutCopyMode = False
Selection.Copy
Range("D12:G12").Select
ActiveSheet.Paste
Range("D7:G7").Select
Application.CutCopyMode = False
Selection.Copy
Range("D13:G13").Select
ActiveSheet.Paste
Range("D8:G8").Select
Application.CutCopyMode = False
Selection.Copy
Range("D14:G14").Select
ActiveSheet.Paste
Range("F9:G9").Select
Application.CutCopyMode = False
Selection.Copy
Range("F15:G15").Select
ActiveSheet.Paste
SendKeys "{ESC}"
ActiveSheet.Range("D17").Select
End Sub
But what it does not do is undo the copy and paste when de-selected. In fact it carries out the copy and paste operation weather the box is ticked or un-ticked.
There is no mention in your code of any checkbox or its current state (aka .Value). Typically, after putting an ActiveX checkbox on the worksheet, you would use Design Mode and right-click it for the View Code command.
Once on the worksheet's code sheet in the VBE, modify the on-click handler to something like this.
Private Sub CheckBox1_Click()
If CheckBox1.Value Then
Range("D5:G8").Copy Destination:=Range("D11")
Range("F9:G9").Copy Destination:=Range("F15")
Else
Range("D11:G14").ClearContents
Range("F15:G15").ClearContents
End If
End Sub
Or you can try this if you want to keep the already assigned copy_address sub.
Sub copy_address()
'
' copy_address Macro
If ActiveSheet.Shapes("Check Box 1").ControlFormat.Value = 1 Then
ActiveSheet.Range("D5:G8").Copy Destination:=ActiveSheet.Range("D11:G14")
ActiveSheet.Range("F9:G9").Copy Destination:=ActiveSheet.Range("F15:G15")
Else
ActiveSheet.Range("D11:G15").ClearContents
End If
End Sub
I am looking for a way to copy and paste text from one sheet to another when I tick a form control checkbox and to delete it when I uncheck it. At the moment the macro I have written does nothing, it doesn't come up with any errors it just doesn't work. What I have so far is:
Sub CheckBox3_Click()
Application.ScreenUpdating = False
If CheckBox3 = True Then
Sheets("Data Sheet").Activate
Range("B1").Select
Selection.Copy
Sheets("Sheet1").Select
Range("C1").Select
ActiveSheet.Paste
Application.ScreenUpdating = True
End If
If CheckBox3 = False Then
ActiveSheet.Range("C1").Select
Selection.Delete
End If
End Sub
Any help would be appreciated, thanks.
To overcome your Runtime error please change your code to
ActiveSheet.Range("B1").Select
and do the same for the target range C1
However, the much more elegant way is to get rid of Select and Activate all together by using VBA rather than "macro recording" ... work with Range objects which will simplify your code, you avoid messy screen jumps etc ...
Private Sub CheckBox1_Click()
Dim SrcRange As Range, TrgRange As Range
Set SrcRange = Worksheets("Data Sheet").[B1]
Set TrgRange = Worksheets("Sheet1").[C1]
If CheckBox1 Then
TrgRange = SrcRange
Else
TrgRange = ""
End If
End Sub