The code I have runs but it does not do what I intend in the last line. The line at the end pastes the formula but it does not adjust the formula for the new cell.
As an example If the formula im copying is is A3 and the formula is A3=A1+A2, when it is pasted into A10 the formula is still A1+A2 instead of A9+A8.
I tried using paste special but I cannot get that to work. I do not want to select a new active cell as I will have to return back to the original active cell and reference it again.
Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+Shift+Z
'
Dim StartCell As Range
Dim copyRance As Range
Dim dataSheet As Worksheet
Dim destSheet As Worksheet
Set dataSheet = Sheets("Macro (insert data)")
Set destSheet = Sheets("Jun-2019")
Set StartCell = ActiveCell
Set copyRange = dataSheet.Range("G4:Q4")
ActiveCell.Resize(copyRange.Rows.Count, copyRange.Columns.Count).Value = copyRange.Value
Set copyRange = dataSheet.Range("W4:AG5")
destSheet.Range("C42").Resize(copyRange.Rows.Count, copyRange.Columns.Count).Value = copyRange.Value
Set copyRange = destSheet.Range("N10:X10")
StartCell.Offset(0, 11).Resize(copyRange.Rows.Count, copyRange.Columns.Count).Value = copyRange.Formula
End Sub
From comments, it seems that you want to copy the Formula, and then convert it to values. This needs to be done in 2 stages, optionally with an explicit .Calculate in case Calculation is set to Manual:
Set copyRange = dataSheet.Range("G4:Q4")
'Copy formulas to ActiveCell
copyRange.Copy Destination:=ActiveCell
With ActiveCell.Resize(copyRange.Rows.Count, copyRange.Columns.Count)
'Force the calculation
.Calculate
'Keep just the values
.Value = .Value
End With
Related
I want to create a command button which copies a range of cells and pastes them into the next empty range.
I have found a code online which I tweaked to perform the function, but it does not work when I add conditional formatting.
The conditional formating being, blank cells = yellow.
The VBA im currently using is:
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Set copySheet = Worksheets("Sheet1")
Set pasteSheet = Worksheets("Sheet1")
copySheet.Range("B11:J11").Copy
pasteSheet.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
If I enter a value into the blank cell the above VBA works fine, however if I leave the cell blank it does not paste into the next cell.
The aim was for the user to paste in as many rows as needed, and the yellow shading to indicate which cells to add a value in.
I hope this makes sense. I'm not particularly used to these functions in excel.
Try this code:
Private Sub CommandButton1_Click()
'Macro to copy in a new row.
'Turning off screen updating.
Application.ScreenUpdating = False
'Declarations.
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Dim targetRange As Range
'Setting variables.
Set copySheet = Worksheets("Sheet1")
Set pasteSheet = Worksheets("Sheet1")
'Setting targetRange as the last cell in column B with value.
Set targetRange = pasteSheet.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
'Setting targetRange as the first cell in column B with no conditional formatting under the last cell in column B with no value.
Do Until targetRange.FormatConditions.Count = 0
Set targetRange = targetRange.Offset(1, 0)
Loop
'Copying range B11:J11.
copySheet.Range("B11:J11").Copy
'Pasting the copied range in targetRange.
targetRange.PasteSpecial xlPasteAll
'Turning off the cut-copy mode.
Application.CutCopyMode = False
'Turning on the screen updating.
Application.ScreenUpdating = True
End Sub
I've taken your code and added the variable targetRange. Said variable is then set as the last cell with value in column B (similar to what you have already done) and then i use a Do Loop cycle to set targetRange as the first cell with no conditional formatting under the last cell with value in column B. I've also added the proper comments to the whole code.
Extra code as requested in comments.
You can obtain a sum of the values of a range while counting any "outgoing" value as a 7 with this formula:
=SUM(B11:B15,COUNTIF(B11:B15,"ongoing")*7)
You can use the same formula in a macro like this:
Sub Macro1()
'A example of macro to return a range sum with any "ongoing" switched with 7.
'Declaration.
Dim rng As Range
'Setting the seed range.
Set rng = Range("B11")
'Expanding rng to the last cell with value of its column.
Set rng = Range(rng, Cells(Rows.Count, rng.Column).End(xlUp))
'Reporting in the immediate window the result.
Debug.Print Excel.WorksheetFunction.Sum(rng, Excel.WorksheetFunction.CountIf(rng, "ongoing") * 7)
'Reporting in the immediate window the result, this time using a With End With statement to make it more readable.
With Excel.WorksheetFunction
Debug.Print .Sum(rng, .CountIf(rng, "ongoing") * 7)
End With
End Sub
I have a range of data - B5:AG1004
In the macro, I need to copy this range and paste it in the next available column. The dedicated space for pasting begins in AX5.
In the code I have now, it copies and pastes the range into the desired (first) position, however once I click the command button again it re-pastes into the exact same place i.e. overwriting the original paste. I need the next iteration to paste in the next available cells to the right.
Here is my code so far;
Sub columnmacro()
ActiveSheet.Range("B5:AG1004").Copy
Sheets("Optimise").Range("ax5").End(xlToLeft).Offset(, 1).PasteSpecial xlValues
Application.CutCopyMode = False
End Sub
Hopefully someone can help, thanks!
Try this:
Sub SubColumnMacro()
'Declarations.
Dim RngSource As Range
Dim RngDestination As Range
'Setting variables.
Set RngSource = ActiveSheet.Range("B5:AG1004")
Set RngDestination = Sheets("Optimise").Range("AX5").Resize(RngSource.Rows.Count, RngSource.Columns.Count)
'Finding the next avaiable spot on the right to report RngSource values.
Do Until Excel.WorksheetFunction.CountBlank(RngDestination) = RngDestination.Cells.Count
Set RngDestination = RngDestination.Offset(0, 1)
Loop
'Reporting Rngsource values in RngDestination.
RngDestination.Value = RngSource.Value
End Sub
I would like to paste directly below data I already have in a column starting at a specific cell however since there is already data in the column I will need to paste the data starting at cell A7.
Any suggestions?
Dim copyNames1 As Range, pasteNames1 As Range
Set copyNames1 = Workbooks("2019 11 November.xls").Worksheets(3).Columns("F")
Set pasteNames1 = Workbooks("VBA Workbook.xlsm").Worksheets(1).Columns("A").Offset(7, 0)
copyNames1.Copy Destination:=pasteNames1
End Sub
This code isn`t working as it returns an error and messes up the rest of the data by repositioning it.
EDIT: Here is another alternative I have tried:
' Activate cell directly below pasted data
Range("A1").End(xlDown).Offset(1, 0).Activate
' CR CARDS
'
' NAMES
Dim copyNamess As Range, pasteNamess As Range
Set copyNamess = Workbooks("2019 11 November.xls").Worksheets(3).Columns("F")
Set pasteNamess = Workbooks("VBA Workbook.xlsm").Worksheets(1).ActiveCell
copyNames1.Copy Destination:=pasteNames1
End Sub
Try this... I added worksheet variables, used resize and incorporate the last row.
'Define your variables
Dim cpyws As Worksheet, pstws As Worksheet, copyNames1 As Range, pasteNames1 As Range
'Assign your worksheet variables
Set cpyws = Workbooks("2019 11 November.xls").Worksheets(3)
Set pstws = Workbooks("VBA Workbook.xlsm").Worksheets(1)
'Assign your copy/paste range variables
Set copyNames1 = cpyws.Cells(1, 6).Resize(cpyws.Cells(cpyws.Rows.Count, 6).End(xlUp).Row) 'I like to use resize and incorporate the last row
Set pasteNames1 = pstws.Cells(pstws.Rows.Count, "A").End(xlUp).Offset(1) 'Set start cell to paste your copied range to
'Copy/Paste
copyNames1.Copy Destination:=pasteNames1
I'm having an Excel Spreadsheet with 3 sheets inside and I need to copy certain cell range from Sheet1 and copy it to Sheet2.
And I'm trying to get the range of cells to be copied as an input in a cell that is available in Sheet 3. Like the cell would have value A4:X6 in it. But I'm unable to get the input values passed on to the Range function in my Macro code.
Below is my code and when I execute, it just enters an empty row in the Sheet 2
Sub CopyData()
Sheet3.Select
Set Range1 = Range(Cells(3, 3).Value)
Sheet1.Select
Range1.Copy
Sheet2.Select
Range("A2").Select
Range("A2").EntireRow.Insert Shift:=xlShiftDown
End Sub
I want the contents of cell denoted in Range1 to be copied from Sheet1 and pasted in Sheet2.
Thank you in advance!
John Coleman is right you can avoid using Select for the whole subroutine. But, your problem here is when you define the range it is defining it specifically for Sheet3 and not Sheet1. One alternative is you could store the address in a string that gets passed to the Range() function, but specify which sheet you want your range to reflect. The rest of the code can be handled much the same without using Select.
Sub CopyData()
Dim range1 as Range
dim strRange as String
strRange = Sheet3.Cells(3, 3).Value
Set range1 = Sheet1.Range(strRange)
range1.Copy Sheet2.Range("A2")
Sheet2.Range("A2").EntireRow.Insert Shift:=xlShiftDown
End Sub
Use Set Range1 = Sheet3.Range(Cells(3, 3).Value) instead of Set Range1 = Range(Cells(3, 3).Value) or the range get selected from sheet1 because of Sheet1.Select
when i execute, it just enters an empty row in the Sheet 2 Of course it does. Your code does exactly that. Line Range("A2").EntireRow.Insert Shift:=xlShiftDown creates the row. There is nothing in your code that pastes the content of range A4:X6 ot whatever input you got in the cell.
Actually, if you delete your code and leave it like this:
Sub CopyData()
Range("A2").EntireRow.Insert Shift:=xlShiftDown
End Sub
You will get the same, a new row inserted.
I want the contents of cell denoted in Range1 to be copied from Sheet1 and pasted in Sheet2
I guess you are trying to copy a specific range, not a whole row and paste it, you need something like this:
Sub CopyData()
Dim Range1 As Range
Set Range1 = Sheet1.Range(Sheet3.Cells(3, 3).Value)
Range1.Copy
Sheet2.Range("A2").PasteSpecial (xlPasteAll) 'this command will paste the contents
End Sub
This example shows how to insert a line above line 2, copied to the format of the line down (line 3) and from the header line
Range("2:2").Insert CopyOrigin:=xlFormatFromRightOrBelow
As you understood, .Insert will always insert blank row.
I guess that you would like to paste a range in your sheet and not insert a new row for this you should do like this :
Sheets("SheetName").Range("A2").PasteSpecial (xlPasteAll)
Also note that xlPasteAll is an XlPasteType as xlPasteFormats , xlPasteValues and so on.
xlPasteAll will paste all
xlPasteFormats will paste the source format
xlPasteValues will paste the value
So your code would be as below :
Sub CopyData()
Dim Range1 As Range
Dim Range2 As Range
Set Range1 = Sheet1.Range(Sheet3.Cells(3, 3).Value)'Will define the range you want to copy
Range1.Copy 'here you copy the range
Set Range2 = Sheet2.Range("A2") 'Set the range where you want to paste data
Range2.PasteSpecial (xlPasteValues) 'then you will paste your range
End Sub
Click here to get the list of those XlPasteType
BONUS
Sheet2.Select
Range("A2").Select
is the same as
Set Range2 = Sheet2.Range("A2")
But the last way is better because it avoid Select which can slow down your performances !
Is there a specific requirement for inserting the copied data at the top or would you be happy adding it to the end of the "list" instead? If so, you could find the last used row and add it at the bottom instead like this:
Sub CopyFromSheet1toSheet2()
Dim thisBook As Workbook: Set thisBook = ThisWorkbook
Dim sheetOne As Worksheet: Set sheetOne = thisBook.Worksheets("Sheet1")
Dim sheetTwo As Worksheet: Set sheetTwo = thisBook.Worksheets("Sheet2")
Dim copyFromRange As Range: Set copyFromRange = sheetOne.Range("A4:X6")
Dim lastRow As Long: lastRow = sheetTwo.Cells(Rows.Count, 1).End(xlUp).Row
Dim pasteToRange As Range: Set pasteToRange = sheetTwo.Range("A" & lastRow)
copyFromRange.Copy Destination:=pasteToRange
End Sub
"lastRow" returns the numeric value of the last used row in a given column. If you have data in A1:A4 then this code would add the next lot of data copied to A5 and below.
In reference to: Copy a row in excel if it matches a specific criteria into a new worksheet
I attempted applying the above hyperlink code to the needs of my own workbook. The only notable differences are: Object names, My data begins in "A2" instead of "A1", and my data is being copied to "L" column in a new worksheet instead of "A" column
Also... you can assume I have generated tabs in excel that correspond with each SelectCell.Value.
Sub Consolidate_Sheets()
Dim MyCell As Range
Dim MyRange As Range
Dim ws As Worksheet
Set MyRange = Sheets("Install_Input").Range("A2")
Set MyRange = Range(MyRange, MyRange.End(xlDown))
Call superSizeMe(MyCell, MyRange)
Sub superSizeMe(SelectCell As Range, SelectRange As Range)
Dim InstallInput As Worksheet
Dim strPasteToSheet As String
'New worksheet to paste into
Dim DestinationSheet As Worksheet
Dim DestinationRow As Range
'Define worksheet with input data
Set InstallInput = ThisWorkbook.Worksheets("Install_Input")
For Each SelectCell In SelectRange.Cells
InstallInput.Select
If SelectCell.Value <> "" Then
SelectCell.EntrieRow.Select ''''LOCATION OF RUN-TIME ERROR 438''''
Selection.Copy
Set DestinationSheet = Worksheets(SelectCell.Value)
Set DestinationRow = DestinationSheet.Range("L1:L" & DestinationSheet.Cells(Rows.Count, "L").End(xlUp).Row)
Range("L" & DestinationRow.Rows.Count + 1).Select
ActiveSheet.Paste
End If
Next SelectCell
InstallInput.Select
InstallInput.Cells(1, 1).Select
If IsObject(InstallInput) Then Set InstallInput = Nothing
If IsObject(SelectRange) Then Set SelectRange = Nothing
If IsObject(SelectCell) Then Set SelectCell = Nothing
If IsObject(DestinationSheet) Then Set DestinationSheet = Nothing
If IsObject(DestinationRow) Then Set DestinationRow = Nothing
End Sub
I am getting a Run-time error'438'
"Object doesn't support this property or method" on "SelectCell.EntireRow.Select"
Well your code has a typo
SelectCell.EntrieRow.Select
should say entire not Entrie. Personally I would use this method anyway, It selects the entire row based on the number you put in. FYI there is also a corresponding Columns().select if you need it in the future
sel_cell_row = SelectCell.Row
Rows(sel_cell_row).select
edit addressed to comment
The reason you get the 1004 error is like it says, the copy and paste areas don't match. Think of copying 10 rows, and trying to paste it into 2 rows, simply wouldn'y work. I'm guessing the problem actually stems from your destinationrows code. I'm not entirely sure what its trying to do, but here are two generic fixes
1)keep the copy code as it is, and modify the paste. Instead of selecting a range of cells to paste into, select the first cell (if your range was a1:a10, selecting a1 is sufficient) excel will then paste all the data starting at that first cell. so in your code do this
'comment out all this destination row stuff
'Set DestinationRow = DestinationSheet.Range("L1:L" & DestinationSheet.Cells(Rows.Count, "L").End(xlUp).Row)
'Range("L" & DestinationRow.Rows.Count + 1).Select
Range("L1").select 'only referencing the first cell to paste into
ActiveSheet.Paste
2)rather than selecting an entire row, why not select only the populated values in that row something like
sel_cell_row = SelectCell.Row
lastColumn = ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column
range(Cells(sel_cell_row ,1),Cells(sel_cell_row ,lastColumn )).select
then do your copy as usual. the 1 is for column 1, or A. I'm assuming the data you want is in one row starting at column A and going till lastColumn. Maybe now this will match your destinationrows code.
3)Com,bine options 1 and 2. so copy only the populated cells, and paste to the first cell in the range