I am trying to copy from one worksheet to another, and the .End property should work with the Range value, but the error saying it isn't! The developer docs haven't helped, so I'm not sure what to do.
Code below, the .End(xlup) is what's throwing the error.
Dim inputcells As Range
Sheets(1).Range("B8:F8").Cut
With Worksheets(2).Range("C1000")
.End (xlUp)
.Offset(1, 0).PasteSpecial xlPasteValues
End With
This will do it,
Sheets(1).Range("B8:F8").Cut Destination:=Sheets(2).Cells(Sheets(2).Rows.Count, "C").End(xlUp).Offset(1)
If you are trying to paste special values with "Cut" it will not work, you can only paste special with "Copy"
One way to get around that is to set the ranges then make the range equal the other range.
Sub Button1_Click()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim CrNg As Range
Dim LstRw As Long
Dim PrNg As Range
Set sh1 = Sheets(1)
Set sh2 = Sheets(2)
Set CrNg = sh1.Range("B8:F8")
With sh2
LstRw = .Cells(.Rows.Count, "C").End(xlUp).Row + 1
Set PrNg = .Range(.Cells(LstRw, "C"), (.Cells(LstRw, "G")))
End With
PrNg.Value = CrNg.Value
End Sub
You can clear CrNg at the end if you want.
Use Copy rather than Cut:
Sub ljsh()
Sheets(1).Range("B8:F8").Copy
Sheets(2).Range("C1000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End Sub
Related
My question is very similar to the following:
Excel VBA code to select non empty cells
However, I have some empty cells in between. In particular, I'm trying to define a range where the first row needs to be excluded, since it's a header. I also have to exclude the empty cells that follow. I was trying something like
Dim wb as workbook, ws as worksheet
Dim myrange as range
'Defined reference wb and ws
myrange=ws.range("B2",range("B2"),end(xldown))
But this only works if there are not empty cells in between. So, is there a fast and simple way to dynamically select a range that includes non-empty cells, excepted the header?
Try this
'Defined reference wb and ws
Set myrange = ws.range("B2", ws.Range("B" & Rows.Count).End(xlUp))
Don't forget to use the Set keyword
Try the next way, please:
Sub testDefineRange()
Dim ws As Worksheet, lastRow As Long, myrange As Range
Set ws = ActiveSheet 'use here what you need
lastRow = ws.Range("B" & ws.rows.count).End(xlUp).row
'Defined reference ws
Set myrange = ws.Range("B2:B" & lastRow)
myrange.Select
End Sub
I have found this link to be very useful on MANY occasions.
https://www.thespreadsheetguru.com/blog/2014/7/7/5-different-ways-to-find-the-last-row-or-last-column-using-vba
Ways To Find The Last Row
Sub FindingLastRow()
'PURPOSE: Different ways to find the last row number of a range
'SOURCE: www.TheSpreadsheetGuru.com
Dim sht As Worksheet
Dim LastRow As Long
Set sht = ActiveSheet
'Using Find Function (Provided by Bob Ulmas)
LastRow = sht.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
'Using SpecialCells Function
LastRow = sht.Cells.SpecialCells(xlCellTypeLastCell).Row
'Ctrl + Shift + End
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
'Using UsedRange
sht.UsedRange 'Refresh UsedRange
LastRow = sht.UsedRange.Rows(sht.UsedRange.Rows.Count).Row
'Using Table Range
LastRow = sht.ListObjects("Table1").Range.Rows.Count
'Using Named Range
LastRow = sht.Range("MyNamedRange").Rows.Count
'Ctrl + Shift + Down (Range should be first cell in data set)
LastRow = sht.Range("A1").CurrentRegion.Rows.Count
End Sub
Ways To Find The Last Column
Sub FindingLastColumn()
'PURPOSE: Different ways to find the last column number of a range
'SOURCE: www.TheSpreadsheetGuru.com
Dim sht As Worksheet
Dim LastColumn As Long
Set sht = ThisWorkbook.Worksheets("Sheet1")
'Ctrl + Shift + End
LastColumn = sht.Cells(7, sht.Columns.Count).End(xlToLeft).Column
'Using UsedRange
sht.UsedRange 'Refresh UsedRange
LastColumn = sht.UsedRange.Columns(sht.UsedRange.Columns.Count).Column
'Using Table Range
LastColumn = sht.ListObjects("Table1").Range.Columns.Count
'Using Named Range
LastColumn = sht.Range("MyNamedRange").Columns.Count
'Ctrl + Shift + Right (Range should be first cell in data set)
LastColumn = sht.Range("A1").CurrentRegion.Columns.Count
End Sub
If it suits your case, I like to use CurrentRegion with Intersect to eliminate the title row.
with ws.range("b2")
set myRange = intersect(.currentregion, .currentregion.offset(1,0))
end with
debug.print myRange.address
I am fairly new in excel VBA and would really appreciate any help on this matter.
The workbook includes data from range A5:AZ1000 (new client info is inputted in new rows, but some cells may be empty depending on the nature of the case). When a user inputs new client info (begins a new row) I would like the existing data (range A5:AZ1000) to shift down one row, and a blank row to appear in range A5:AZ:5. I would like users to be able to click a macro "New Client" for this to happen.
It should be noted that this is a shared workbook and therefore I cannot have macro that adds a new row.
Here is the code I'm working with:
Sub shiftdown()
' shiftdown Macro
Dim lastRow As Long
Dim lastColumn As Long
Dim rngToCopy As Range
Dim rng As Range
Set rng = ActiveSheet.Range("A1").Value
lastColumn = ActiveSheet.Cells(4, Columns.Count).End(xlToLeft).Column
lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
If rng > 0 Then
ActiveSheet.Range("A5" & lastRow).Select
Selection.Copy
PasteSelection.Offset(1, 0).PasteSpecial xlPasteValues
'Error Object Required
End If
End Sub
Normally I wouldn't answer if the question doesn't include any code to show effort, but I started writing the below while the question actually did show code so I may as well provide it. It may achieve what you are after.
Sub shiftdown()
' shiftdown Macro
Dim rng As Range
With ActiveSheet
If .Range("A1").Value > 0 Then
Set rng = .Range(.Cells(5, 1), _
.Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, _
.Cells(4, .Columns.Count).End(xlToLeft).Column))
rng.Offset(1, 0).Value = rng.Value
.Rows(5).EntireRow.ClearContents
End If
End With
End Sub
Set rng = ActiveSheet.Range("A1").Value ???
if rng is a range, then replace it by :
Set rng = ActiveSheet.Range("A1")
or if rng is a variable, replace
Dim rng As Range
by
Dim rng As variant
rng = ActiveSheet.Range("A1").Value
another error :
you declared rng as range and then you test if it is > 0
If rng > 0 Then ...
it is not possible
I have two worksheets, in the second worksheet i have defined all the parameters unique name
in the first sheet i have defined the just the parameters name, on the click of Auto Fill Button i want it to go and check all the parameters name in the Acronym sheet and if the match is found it should replace the particular parameter's unique id.
Could anyone please tell me how to achieve this using excel VBA, Any help is appreciated!
Loop through one to find the other.
Sub DoIt()
Dim sh As Worksheet, ws As Worksheet
Dim LstRw As Long, rng As Range, c As Range, Frng As Range
Set sh = Sheets("Sheet1") 'Acronym Sheet
Set ws = Sheets("Sheet2")
With sh
LstRw = .Cells(.Rows.Count, "B").End(xlUp).Row
Set rng = .Range("B2:B" & LstRw)
End With
With ws
For Each c In rng.Cells
Set Frng = .Range("C:C").Find(what:=c, lookat:=xlWhole)
If Not Frng Is Nothing Then
Frng.Value = c.Offset(, -1).Value
Else:
End If
Next c
End With
End Sub
I'm trying to copy a column to the right of table and paste the formulas only (not values).
Sub acrescentaCols()
Dim oSheet As Worksheet
Set oSheet = Sheets("Sheet1")
oSheet.Columns("D:D").Select
Selection.Copy
Range(Selection, Selection.End(xlToRight)).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End Sub
But this is copying also the values (because Excel considers values to be a formula too).
How do I fix this?
The below should fix your immediate problem of only copying the formulas across and not the values, but I'm not sure exactly what you're trying to do. If you can give more information I'm sure I can help you acheive what you're trying to get to.
It seems as if you want to copy the formulae to every row to the right of column D to the very right edge of the worksheet?
It also seems like you want to copy the formulae only so they re-evaluate in their new location - or do you want to past values only so that they hold the same values that they evaluated to in column D?
Anyway, give this a whirl.
Sub acrescentaCols()
Dim oSheet As Worksheet
Set oSheet = Sheets("Sheet1")
For Each cell In oSheet.Range("D1", Range("D1").End(xlDown))
If cell.HasFormula = True Then
cell.Copy
Range(cell.Address, Range(cell.Address).End(xlToRight)).PasteSpecial Paste:=xlPasteFormulas
End If
Next cell
End Sub
As per my comments earlier:
Sub acrescentaCols()
Dim oSheet As Worksheet
Dim rng As Range
Dim cel As Range
Set oSheet = Sheets("Sheet1")
With oSheet
Set rng = .Range(.Range("D1"), .Range("D" & .Rows.Count).End(xlUp))
For Each cel In rng
If Left(cel.Formula, 1) = "=" Then
Range(cel.Offset(, 1), cel.Offset(, 1).End(xlToRight)).Formular1c1 = cel.Formular1c1
End If
Next cel
End With
End Sub
When you say paste the formula only - your method will paste the formula and then recalculate and your formula will show the result. I think a better way to write that would be:
Sub acrescentaCols()
Dim oSheet As Worksheet
Dim rCopied As Range
Set oSheet = Sheets("Sheet1")
With oSheet
.Columns("D:D").Copy
Set rCopied = .Cells(1, 4).End(xlToRight).Offset(, 1).EntireColumn
rCopied.PasteSpecial Paste:=xlPasteFormulas
End With
End Sub
If you want to show the actual formula you could use a UDF something like:
Function GetFormula(Target As Range) As String
If Target.HasFormula Then
GetFormula = Target.Formula
End If
End Function
If you want to apply this to a whole column you could use:
Sub acrescentaCols1()
Dim oSheet As Worksheet
Dim rCopied As Range
Set oSheet = Sheets("Sheet1")
With oSheet
Set rCopied = .Cells(1, 4).End(xlToRight).Offset(, 1).EntireColumn
rCopied.FormulaR1C1 = "=GETFORMULA(RC4)"
End With
End Sub
This will probably kill your spreadsheet though - it will execute the UDF on all rows.
Sub acrescentaCols()
Dim oSheet As Worksheet, rng1 As Range, rng2 As Range, rng As Range
Set oSheet = Sheets("Sheet1")
Set rng1 = oSheet.Columns("D:D")
Set rng1 = Intersect(rng1, rng1.Worksheet.UsedRange) 'for the used range only
Set rng2 = Range(rng1, rng1.End(xlToRight))
For i = 1 To rng1.Cells.Count 'for each row
If Left(rng1(i, 1).Formula, 1) = "=" Then 'if it starts with an equal sign
For j = 1 To rng2.Columns.Count 'then for each column in the copy
rng2(i, j).FormulaR1C1 = rng1(i, 1).FormulaR1C1
Next j
End If
Next i
End Sub
I am trying to loop through different sheets in my workbook. I have tried searching through stackoverflow but still stuck with the error. The error showed "Method 'Range' of object'_Worksheet' failed.
The purpose of this code is to standardise all formats in the worksheets.
Sub formatting()
Dim ws as Worksheet
Dim lastRow as long, lastColumn as long
lastRow = Range("A" & Rows.Count).End(xlUp).Row
lastColumn = (Cells(1, Columns.Count).End(xlToLeft).Column)
For each ws in Activeworkbook.Worksheets
With ws.Range(cells(lastRow, 1), cells(1, lastColumn))
'rest of the actions I want to perform'
.font.bold = true
End With
Next ws
End Sub
I just got started on Excel vba, please enlighten me! Thank you!
Few changes to be made:
1. You have to redefine the last row and last column for each sheet. With that said, place the variable assignment inside the loop.
Instead of ws.Range(cells...), the proper syntax is Range(ws.cells...)
See below:
Sub formatting()
Dim ws As Worksheet
Dim lastrow As Long, lastcolumn As Long
For Each ws In ActiveWorkbook.Worksheets
lastrow = ws.Range("A" & Rows.Count).End(xlUp).Row
lastcolumn = (Cells(1, Columns.Count).End(xlToLeft).Column)
With Range(ws.Cells(1, 1), ws.Cells(lastrow, lastcolumn))
'rest of the actions I want to perform'
.Font.Bold = True
End With
Next ws
End Sub
You have to qualify the Cells calls as well as the Range call:
With ws.Range(ws.cells(lastRow, 1), ws.cells(1, lastColumn))
If you just got started in VBA I'd learn about setting ranges using .currentregion this will greatly help you in the future.
The code snippet makes all fields bold. If you are applying to all then currentregion can save code and possible errors on one condition "that all the fields are connected."
Sub formattingWithCurrentRegion()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Range("A1").CurrentRegion.Font.Bold = True
Next ws
End Sub
By setting the area as a range you can get greater control over ranges to set different formatting without having to deal with loops in loops.
See below
Sub formattingWithCurrentRegion()
Dim ws As Worksheet
Dim rSheet As Range
For Each ws In ActiveWorkbook.Worksheets
'' sets the CurrentRegion as a range. Use the immediate window rSheet.Select to see what CurrentRegion does.
Set rSheet = ws.Range("A1").CurrentRegion
'' now you can work with it
rSheet.Font.Bold = True
'' make the 2 column font.color to Red
rSheet.Resize(rSheet.Rows.Count, 1).Offset(0, 1).Font.Color = vbRed
''now clean up. Always set ranges to nothing when done with them.
Set rSheet = Nothing
Next ws
End Sub