I have been working on code to copy and paste from one worksheet to another. The data that I need to copy will always be at A1:E1, however, I need to always paste one row below. I will run it everyday, so for instance if today I paste on cells A1:E1, then tomorrow I would need to paste on A2:E2 and on the next day A3:E3... I wrote the code below which works but is not as dynamic as I need it to be. I would appreciate your help
Thank you
Sub Copy_range()
Worksheets("Dividends").Range("A1:E1").copy
Worksheets("Draft").Range("A1:E1").PasteSpecial
End Sub
This will make it more modular by skipping down past all used cells then pasting the value on the next empty cell.
Sub Copy_range()
' edit line below to change where data will be copied from
Worksheets("Dividends").Range("A1:E1").Copy ' copy the value
' select the first cell on the "Draft" sheet
Worksheets("Draft").Select
ActiveSheet.Range("A1").Select
Dim count As Integer
count = 1
'skip all used cells
Do While Not (ActiveCell.value = None)
ActiveCell.Offset(1, 0).Range("A1").Select
count = count + 1
Loop
' edit line below to change alphabetical values of where data will be placed
Worksheets("Draft").Range("A" & count & ":E" & count).PasteSpecial ' paste the value
' at Acount:Ecount where count is the current row i.e. A11:E11
End Sub
Related
So my code is to insert a row, copy its format from the previous row, and then insert the formulas that I have preset on a different row. So lets say I insert a new row, row 11, the formula should copy row 10's formats and insert the formulas from row 44 (which I designated as my formula row).
Now, the formulas will all reference row 10 instead of row 11. I'm not sure why that is.
Here is my code:
Dim i As Integer
'loop through position sheets and insert blank rows
For i = 1 To 4
Sheets(i).Select
Rows(row_to_insert).EntireRow.Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Next i
'loop through sheets and copy/paste formulas into new rows
For i = 1 To 4
Sheets(i).Select
Rows(blank_row_to_use + 1).EntireRow.Select
Selection.Copy
Rows(row_to_insert).EntireRow.Select
ActiveSheet.Paste
Next I
End Sub
This worked fine until I added a new sheet, and expanded from For i = 1 To 3 to For i = 1 to 4.
Any ideas why it suddenly stopped working?
the issue lays in those relative references to another sheet that don't get updated by any rows shifts taking place in the sheet where they are used
while they'd get updated if you shifted rows in the sheet they are referencing
so you have to play a little bit with relative /absolute references to mimic some referenced sheet rows shifting, but without doing it!
for instance you could use a Function that converts some range formulas to absolute or relative reference type, like the following:
Sub Convert(rng As Range, toReferenceType As XlReferenceType)
Dim cell As Range
For Each cell In rng.SpecialCells(XlCellType.xlCellTypeFormulas) ' loop thorugh passed range relevant cells (i.e. those containing formulas)
If InStr(cell.Formula, "!") > 0 Then cell.Formula = Application.ConvertFormula(cell.Formula, xlA1, xlA1, toReferenceType) ' if current cell has an explicit sheet reference, then convert its formula to the passed reference type
Next
End Sub
and the use it in your code
For i = 1 To 1
With ThisWorkbook.Sheets(i)
.Rows(blank_row_to_use).Copy .Rows(blank_row_to_use + 1) ' copy formulas "template" row one "helper" row below
Convert .Rows(blank_row_to_use + 1), xlAbsolute ' convert "helper" row formulas with some explicit sheet reference to absolute type so they don't get updated by any subsequent row shift
.Rows(blank_row_to_use + 1).Copy .Rows(blank_row_to_use) ' copy "helper" row converted formulas and paste them back to formula "template" row -> now you have a formula with an absolute row reference one below its own row
.Rows(blank_row_to_use + 1).ClearContents ' clear "helper" row
.Rows(row_to_insert).Insert Shift:=xlDown, opyOrigin:=xlFormatFromLeftOrAbove ' insert new row -> formulas "template" row references don't get updated and now you have a formula with an absolute row reference to its own row
Convert .Rows(blank_row_to_use + 1), xlRelative ' convert formulas "template" row formulas with some explicit sheet reference to relative type so they do get updated by any subsequent row shift
.Rows(row_to_insert).EntireRow.Formula = .Rows(blank_row_to_use + 1).EntireRow.Formula ' copy formulas "template" row formulas row to the new row and have them updated
End With
Next
Please note also that
.Rows(row_to_insert).EntireRow.Formula = .Rows(blank_row_to_use + 1).EntireRow.Formula
is better than any Copy and subsequent PasteSpecial approach in that it doesn't use the clipboard
Try the much shorter and cleaner version of what you are trying to achieve.
Note: try to avoid using Select, Selection and ActiveSheet, and use fully qualified Sheet objects.
Modified Code
'loop through position sheets and insert blank rows
For i = 1 To 4
With ThisWorkbook.Sheets(i)
.Rows(row_to_insert).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Rows(blank_row_to_use + 1).EntireRow.Copy
.Rows(row_to_insert).EntireRow.PasteSpecial xlPasteFormulas
End With
Next i
I have a spreadsheet with customer information that I want to search on by last name. I want to enter the last name on a separate sheet (Sheet 1) and have the macro search the Last Name column in the customer data spreadsheet (Sheet 2). When it finds a match, I want it to copy the entire row in Sheet 2 and paste it to a specific row in Sheet 1. I've searched a number of sites and tried numerous versions of code but cannot get it to work.
Here's a link that shows you how to get data from another sheet or workbook. Basically you use Sheet_name!Cell_address or Sheet_name!First_cell:Last_cell.
Hope this helps :)
I think this sounds simple enough, loop until you find the value you want. How do you want the trigger to fire? the below into sheet 2 into the will trigger after double clicking on a selected cell in column 1, will prompt you for input, then copy the first match.
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column <> 1 Then Exit Sub 'or which ever column you enter for
Dim str_Act, str_Test As String
Dim i As Integer
'find value to search
str_Act = InputBox("Enter User Last Name")
If str_Act = "" Then Exit Sub
'loop to find search
Do While str_Act <> str_Test
str_Test = Sheets(1).Range("A1").Offset(i, 0) ' or whichever column has your value
i = i + 1
Loop
'Copy and paste
Sheets(1).Range("A1:ZZ1").Offset(i - 1, 0).Copy
Target.PasteSpecial
End Sub
I am not a programmer but would appreciate some help!
I am trying to take a range of cells, and paste them in another part of the spread sheet but in the correct column that I want (the column will change later that's why I want it to identify the column to paste the cells into the right row)
Example, take cells (A2:A10) and paste them into the "TTM" column D4:D12... where I have put the text TTM into D1... later, TTM may become E1, in which case the A2:A10 cells need to be moved to E4:E12...
Thanks a lot!
The following Function can be used to do what you want. You will need to explain what will trigger this code and if you want to search other than the 'Active Sheet'
Function Move_Cells()
Dim iCols As Integer
Dim i As Integer
Dim strKey As String
Dim iNewCol As Integer
strKey = "TTM" ' Set this to whatever label you want to search row 1 for.
iCols = ActiveSheet.UsedRange.Columns.Count ' Get count of used columns
For i = 1 To iCols ' Find column containing 'TTM'
If LCase(Cells(1, i).text) = LCase(strKey) Then ' ignore case inCASE SoMeBody....
iNewCol = i ' Save col # containing search keyword
Exit For
End If
Next i
'ActiveSheet.Range("A2:A10").Copy ' Where to copy from
'ActiveSheet.Cells(2, iNewCol).PasteSpecial xlPasteValues ' Paste into new location
'Application.CutCopyMode = False
' Try the following instead of the previous copy/paste
Range("A2:A10").Select
Selection.Copy
Cells(2, iNewCol).Select
ActiveSheet.Paste
End Function
I recently posted a question, and unfortunately did not get very far with any answers. I have re-worked my macro to mirror a similar scenario I found elsewhere. The problem is I am now getting stuck at the very end.
Purpose of the macro:
1. Beneath the selected cell, I need to insert x new rows = entered months -1
In the first inserted row, I need a set of relative formulas that can be found in the Actual Row 2 of the current worksheet (basically copy and paste row 2 into the first row created)
In the subsequent inserted rows, I need a set of relative formulas that can be found in the Actual Row 3 of the current worksheet
As is, the macro does what I want, except I don't know how to paste row 3 in all subsequent rows. I'm assuming I need some conditional statement?
As mentioned in my last post, I am trying to teach myself VBA, so any help would be appreciated!!
Sub InsertMonthsAndFillFormulas(Optional vRows As Long = 0)
Dim x As Long
ActiveCell.EntireRow.Select 'So you do not have to preselect entire row
If vRows = 0 Then
vRows = Application.InputBox(prompt:= _
"Enter the total number of months in the program", Title:="Add Months", _
Default:=1, Type:=1) 'Default for 1 row, type 1 is number
If vRows = False Then Exit Sub
End If
Dim sht As Worksheet, shts() As String, i As Long
ReDim shts(1 To Worksheets.Application.ActiveWorkbook. _
Windows(1).SelectedSheets.Count)
i = 0
For Each sht In _
Application.ActiveWorkbook.Windows(1).SelectedSheets
Sheets(sht.Name).Select
i = i + 1
shts(i) = sht.Name
x = Sheets(sht.Name).UsedRange.Rows.Count 'lastcell fixup
Selection.Resize(rowsize:=2).Rows(2).EntireRow. _
Resize(rowsize:=vRows - 1).Insert Shift:=xlDown
Rows(2).EntireRow.Copy Destination:=Selection.Offset(1).Resize( _
rowsize:=1)
Rows(3).EntireRow.Copy Destination:=Selection.Offset(2).Resize( _
rowsize:=1)
On Error Resume Next
Next sht
Worksheets(shts).Select
End Sub
Ok, based on your comments, the below code should meet your needs. But first, a few things to note.
I've added several comments to help you understand what is happening in the code.
Based on your comment regarding vRows, the code will now terminate if the user keeps the default input box value ("1"). The logic is that if the value is only one, then no rows need to be added. Notice that I subtract 1 from the Inputbox value.
The code assumes you have headers or at least filled cells in row one. I use row one to find the last used column.
If there's any chance that the wrong sheet can be active when this code is executed, uncomment line 16 of my code. (Obviously you'd need to change the code to reflect your sheet's name.
Finally, this code assumes that the upper-left corner of your dataset is in A1.
Tested on Sample Dataset
Sub InsertMonthsAndFillFormulas(Optional vRows As Long = 0)
Dim lastCol As Long
Dim r As Range
'Ask user for number of months.
'If the user keeps the default value (1), exit sub.
If vRows = 0 Then
vRows = Application.InputBox(prompt:= _
"Enter the total number of months in the program", Title:="Add Months", _
Default:=1, Type:=1) - 1
If vRows = 0 Then Exit Sub
End If
'Uncomment this line if you are concerned with which sheet needs to be active.
'ThisWorkbook.Sheets("YourSheet").Select
With ActiveSheet
'Set the range to work with as the cell below the active cell.
Set r = ActiveCell.Offset(1)
'Find the last used column. (Assumes row one contains headers)
'Commented this out to hard-code the last column.
'lastCol = .Rows("1:1").Find("*", searchdirection:=xlPrevious).Column
'Insert the new rows.
r.EntireRow.Resize(vRows).Insert Shift:=xlDown
'r needs to be reset since the new rows pushed it down.
'This time we set r to be the first blank row that will be filled with formulas.
Set r = .Range(.Cells(ActiveCell.Offset(1).Row, 1), _
.Cells(ActiveCell.Offset(1).Row, "H")) '<~~ Replaced lastCol with "H"
'**Add formulas to the new rows.**
'Adds row two formulas to the first blank row.
.Range(.Cells(2, 1), .Cells(2, "H")).Copy r
'Adds row three formulas to the rest of the blank rows.
.Range(.Cells(3, 1), .Cells(3, "H")).Copy r.Offset(1).Resize(vRows - 1)
End With
End Sub
Edit
The variable lastCol is what defines the right most column to copy formulas from. This variable is set using column headers in row 1. I prefer using variables like this to make the code more robust (i.e. you can add a column to your dataset without breaking the macro), however, for this to work you need headers above every used column (or at least cells that contain values).
If you aren't concerned with adding more columns in the furture, you can hard-code the last column into the code (see my revisions).
I'm really hoping someone can help me with this one. I have recorded a macro to use within a sheet that needs to create a row at the same position on 2 worksheets and then, on one of them, copy the formula's in the cells from the row below it. The code I have looks like this -
Sub Macro1()
Sheets(Array("SCHEDULE", "ANNUAL SUMMARY")).Select
Sheets("SCHEDULE").Activate
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("ANNUAL SUMMARY").Select
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.AutoFill Destination:=ActiveCell.Offset(-1, 0).Rows("1:2").EntireRow _
, Type:=xlFillDefault
ActiveCell.Offset(-1, 0).Rows("1:2").EntireRow.Select
Sheets("SCHEDULE").Select
ActiveCell.Select
My problem is, when I run it manually and then record the macro, it does exactly what I want it to, but when I run this from a button on the "SCHEDULE" sheet it does not copy the formula's from the row below the one on the "ANNUAL SUMMARY" sheet.
Can anyone help to get this working with me?
Thanks all in advance
Mark
The problem with the macro recorder is that although it can give you a good indication of what code you need, it also generates very inefficient code and includes all of the select and activate statements that you need to try and avoid using.
Any reference in the code to ActiveCell is referring to the cell that is currently selected and ActiveSheet is the sheet that is currently selected. This can give you undesired results if you run the macro from a different sheet that the macro was recorded from...
If you wanted to copy row 1 from SCHEDULE sheet then you can use
Sheets("SCHEDULE").Rows(1).Copy Sheets("ANNUAL SUMMARY").Rows(1)
If you want to auto fill a range, then this can be accomplished with a single line of code
This will auto fill the contents of row1 (column A - E) down to row 100 in your ANNUAL SUMMARY sheet
Sheets("ANNUAL SUMMARY").Range("A1:E100").FillDown
So if we put it all together and include some declarations for our source and destination sheet to make the sub more readable..
Sub CopyAndFillDownExample()
Dim rowNumber As Long, offset As Long
Dim sourceSht As Worksheet, destinationSht As Worksheet
'set the source and destinationsheets
Set sourceSht = Sheets("SCHEDULE")
Set destinationSht = Sheets("ANNUAL SUMMARY")
'number of rows to copy down
offset = 100
'get currently selected row
rowNumber = ActiveCell.Row
'copy the selected row from the source sheet to the destination sheet
sourceSht.Rows(rowNumber).Copy destinationSht.Rows(rowNumber)
'fill down the formulas
destinationSht.Rows(rowNumber & ":" & rowNumber + offset).FillDown
End Sub