I am copying a value from one workbook to another and, when I paste it, I need the value to link back to its original source. I got it to work that the cell hyperlinks. However, I'm pasting into a variable cell, so it keeps pasting in the wrong location. Does anyone know how to make where I put stars ** below refer to the active cell?
Dim rng, clm As Range
With ActiveWindow
Set rng = Cells(ActiveCell.Row)
Set clm = Cells(ActiveCell.Column)
rng.Activate
clm.Activate
End With
With ActiveCell
Selection.PasteSpecial paste:=xlPasteValues
End With
With ActiveCell
.Hyperlinks.Add Anchor:=.Range(**rng, clm**), Address:=FilePath, ScreenTip:="The screenTIP", TextToDisplay:=FilePath
End With
Try the following instead of the second With ActiveCell:
With ActiveSheet
.Hyperlinks.Add Anchor:=ActiveCell, Address:=FilePath, ScreenTip:="The screenTIP", TextToDisplay:=FilePath
End With
Related
I have created a loop where data is copied from a worksheet and pasted into another, however I am having problems with the paste function – sometimes the wrong data gets pasted, seemingly randomly. My current code is:
Sub ACCPR_LOOP()
Dim wsACC_PR As Worksheet
Set wsACC_PR = ThisWorkbook.Sheets("ACC PR")
Dim wsPR_CALC As Worksheet
Set wsPR_CALC = ThisWorkbook.Sheets("PR - CALC")
Dim MyRange As Range
Dim MyCell As Range
Set MyRange = Range("A2:A145")
Application.ScreenUpdating = False
Columns("B:C").ClearContents
For Each MyCell In MyRange
MyCell.Copy
wsPR_CALC.Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
wsPR_CALC.Range("B226,B228").Copy
MyCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Transpose:=True
Next MyCell
End Sub
What the code is doing is in Col A are a bunch of dates, it copies the date in A, then pastes it into another worksheet to update a drop-down date selector and change the data. Two of the cells are then copied and pasted back into the original worksheet with an offset of 1 column. For some reason sometimes, the data from the previous date in A is pasted. For example, the date in A17 is copied and pasted into the date selector, the correct data is then pasted into B17, but on the next step, the data relating to A17 is pasted into the next row down at B18.
If a repeat the line:
MyCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Transpose:=True
the code works but this seems rather inefficient. Any ideas what’s going on in my code and how I can fix it?
In the Set MyRange = Range("A2:A145") you should declare the corresponding worksheet as well. E.g.:
Set MyRange = Worksheets("MyNameIsWhat").Range("A2:A145")
Otherwise, it would take the ActiveWorksheet and the MyRange would be assigned to it.
The same goes to Columns("B:C").ClearContents.
It should be Worksheets("TsakaTsakaSlimShaddy").Columns("B:C").ClearConents
I always try to avoid the copy/paste function in VBA. It's processor intensive and functions ... arcanely.
Try this instead:
For Each MyCell In MyRange
wsPR_CALC.Range("A1").Value = MyCell.Value
Application.Calculate
MyCell.Offset(0, 1).Value = wsPR_CALC.Range("B226,B228").Value
Next MyCell
You'll lose the number formatting, but there are other ways of doing that.
I also added an Application.Calculate line, because it looks like you're copying from a formula in the second step, and it's good to make sure that value gets updated. You can also try Application.CalculateFull if plain .Calculate isn't cutting it.
Also, to echo Vit, if you're working with multiple sheets, declaring your sheet as often as possible will help as well.
I put together a VBA code to take the values off a form on one worksheet and insert them into another worksheet without the blank cells inbetween, then clear the original form.
However, I run into the error "Runtime Error 1004: Command cannot be used on multiple selections" and cannot figure out what is causing it. After a little research, it seems that saving and reopening the workbook makes this error go away, but not always.
Any ideas?
Sub DataEntry()
'--- Find rows that contain any value in column G or H and copy them
Dim cell As Range
Dim selectRange As Range
For Each cell In ActiveSheet.Range("G3:H90")
If (cell.Value <> "") Then
If selectRange Is Nothing Then
Set selectRange = cell
Else
Set selectRange = Union(cell, selectRange)
End If
End If
Next cell
selectRange.EntireRow.Select
selectRange.EntireRow.Copy
'Paste copied selection to the worksheet 'Data' on the next blank row
Sheets("Data").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial _
Paste:=xlPasteValues
'Delete content of rows after copy and paste
Union(Range("G3:G150"), Range("H3:H150")).ClearContents
The problem seems to be that the EntireRow property is becoming a variant and not a range. I initially tried to fix this by just declaring a variable as a Range, but this didn't work either. However, by doing the original Union on rows instead of cells, I was able to get this to work.
Sub DataEntry()
'Find rows that contain any value in column G or H and copy them
Dim cell As Range
Dim selectRange As Range
Dim rowRange As Range
For Each cell In ActiveSheet.Range("G3:H90")
If (cell.Value <> "") Then
If selectRange Is Nothing Then
Set selectRange = cell.EntireRow
Else
Set selectRange = Union(cell.EntireRow, selectRange)
End If
End If
Next cell
'No need to select anything here, just copy.
selectRange.Copy
.....
I'm not entirely sure why this is happening, but this fixed it for me.
EDITED because the original fix did not work.
I have a piece of "crude" code which copies some data from one sheet to Another, and the sheet-name from which the data is copied can be found in a cell. However, the number of sheets are now growing, and I have created a dynamic named range for the sheetnames, and would like to perform the following code for all the sheets in the dynamic range. My code looks like this:
Calculate
' get the worksheet name from cell AA3
Worksheets(Range("AA3").Value).Activate
' Copy the data
Range("A1:A1500").Select
Selection.Copy
' Paste the data on the next empty row in sheet "Artiklar"
Sheets("Artiklar").Select
Dim NextRow As Range
Set NextRow = Range("A65536").End(xlUp).Offset(1, 0)
NextRow.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Now, I would like to have something like a loop with reference to the dynamic range but I am unable to get it to work as VBA really is not my cup of tea...So, instead of referencing AA3, AA4 etc I would like to referebnce the named range which contains the data of AA3, AA4....AAx. The named range might also contain blank cells, as it is the result of an Array formula in AA3....AA150.
Thank you!
/Fredrik
The following code should work for you. I assumed that the named range (i called it copysheets) is in the active workbook (scope workbook).
Sub copySheets()
Dim sheetName As Range
Dim copyRange As Range
Dim destinationRange As Range
For Each sheetName In Range("copysheets")
If sheetName.Value <> "" And sheetName.Value <> 0 Then
Set copyRange = Sheets(sheetName.Value).Range("A1:A1500")
Set destinationRange = Sheets("Artiklar").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
copyRange.Copy
destinationRange.PasteSpecial xlPasteValues
End If
Next
End Sub
Dim myNamedRng as Range, cell as Range
'...
Set myNamedRng = Worksheets("MySheet").Range("myRange") '<-- set a variable referencing your named Range
With Sheets("Artiklar")
For Each cell In myNamedRng
If cell.Value <>"" Then .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(1500).Value = Worksheets(cell.Value).Range("A1:A1500").Value
Next cell
End With
The following example loops through each cell in a named range by
using a For Each...Next loop. If the value of any cell in the range
exceeds the value of Limit, the cell color is changed to yellow.
vba
Sub ApplyColor()
Const Limit As Integer = 25
For Each c In Range("MyRange")
If c.Value > Limit Then
c.Interior.ColorIndex = 27
End If
Next c
End Sub
Source
So you might start off with something like this:
Calculate
Dim NextRow As Range
' get a range object from the named range
For Each c In Range("[File.xls]Sheet1!NamedRange")
' Copy the data
Worksheets(c.Value).Range("A1:A1500").Copy
' Paste the data on the next empty row in sheet "Artiklar"
Sheets("Artiklar").Activate
Set NextRow = Range("A65536").End(xlUp).Offset(1, 0)
NextRow.PasteSpecial xlPasteValues
Next c
You'll notice that I was a bit more explicit with how the named range is being referred to - the requirement here might vary depending on how you declared the range to begin with (what its scope is), but the way I did it will most likely work for you. See the linked article for more information about scope of named ranges.
-= Problem Solved =-
Thank you all for your contribution to my question! All the answers that I received has helped me refine my code, which is now functioning properly!
Regards,
Fredrik
I have written the code for getting the blank cell information but the problem is that I want to copy the data which are before the blank call. After the blank cell there might be a value. Here's my code:
Set rng = Range("6:6").Find(What:=horiz, LookIn:=xlValues, LookAt:=xlWhole)
If rng Is Nothing Then
MsgBox "Value not found in row 1", vbExclamation
Else
rng.EntireColumn.Copy
Range("p1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
MsgBox Range("C1").End(xlDown)(2, 1).Value
I can't really see your data set, so hard to say this is bullet proof, but from what your post says, this may be what you need.
Change
rng.EntireColumn.Copy (which copies the entire column)
to
Range(rng, rng.end(xlDown)).Copy which copies the range from the found range to the last cell before a blank.
If you want to copy all the cells above the found range, until you find a blank above, and all the cells below, write this:
Range(rng.End(xlUp), rng.End(xlDown)).Copy
I'm trying to write a macro that copies the content of column 1 from sheet 1 to column 2 on sheet 2. This is how the module looks like but, when I run it, I get
Run time error 9, Subscript out of range.
Sub OneCell()
Sheets("Sheet1").Select
'select column 1 A1'
Range("A1:A3").Select
Selection.Copy
Range("B1:B3").Select
ActiveSheet.Paste
Sheets("Sheet2").Select
Application.CutCopyMode = False
End Sub
The following works fine for me in Excel 2007.
It is simple, and performs a full copy (retains all formatting, etc.):
Sheets("Sheet1").Columns(1).Copy Destination:=Sheets("Sheet2").Columns(2)
"Columns" returns a Range object, and so this is utilizing the "Range.Copy" method. "Destination" is an option to this method - if not provided the default is to copy to the paste buffer. But when provided, it is an easy way to copy.
As when manually copying items in Excel, the size and geometry of the destination must support the range being copied.
Selecting is often unnecessary. Try this
Sub OneCell()
Sheets("Sheet2").range("B1:B3").value = Sheets("Sheet1").range("A1:A3").value
End Sub
If you have merged cells,
Sub OneCell()
Sheets("Sheet2").range("B1:B3").value = Sheets("Sheet1").range("A1:A3").value
End Sub
that doesn't copy cells as they are, where previous code does copy exactly as they look like (merged).
I'm not sure why you'd be getting subscript out of range unless your sheets weren't actually called Sheet1 or Sheet2. When I rename my Sheet2 to Sheet_2, I get that same problem.
In addition, some of your code seems the wrong way about (you paste before selecting the second sheet). This code works fine for me.
Sub OneCell()
Sheets("Sheet1").Select
Range("A1:A3").Copy
Sheets("Sheet2").Select
Range("b1:b3").Select
ActiveSheet.Paste
End Sub
If you don't want to know about what the sheets are called, you can use integer indexes as follows:
Sub OneCell()
Sheets(1).Select
Range("A1:A3").Copy
Sheets(2).Select
Range("b1:b3").Select
ActiveSheet.Paste
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, r As Range
Set rng = Intersect(Target, Range("a2:a" & Rows.Count))
If rng Is Nothing Then Exit Sub
For Each r In rng
If Not IsEmpty(r.Value) Then
r.Copy Destination:=Sheets("sheet2").Range("a2")
End If
Next
Set rng = Nothing
End Sub