I need to move data from one sheet to another by the criteria date, but the selection that I made using IF only select the last cell that matches that criteria.
Here is what i got so far:
Sub Copiar()
Dim range1 As Range
Set range1 = Range("k56:k58")
For Each cell In range1
If cell.Value = Range("R55").Value Then
cell.Offset(0, 2).Select
Selection.Copy
Sheets("Plan2").Activate
Range("r56").Select
ActiveSheet.Paste
End If
Next
End Sub
You are finding them all, the problem is that every answer overwrites R56 on the other sheet. Here's code that advances that destination cell every repeat of the loop - and also avoids the bad practice of selecting and activating every sheet and cell you are working with:
Sub Copiar()
Dim range1 As Range, destin as Range
Set range1 = Range("k56:k58")
Set destin= Sheets("Plan2").Range("r56")
For Each cell In range1
If cell.Value = Range("R55").Value Then
cell.Offset(0, 2).copy destin
set destin=destin.offset(1,0) ' Crucial bit here
End If
Next
End Sub
I'm assuming you don't want to overwrite Sheets("Plan2").Range("r56") each time you find the value.
If that's the case, this code writes the found value into the same row it is found on the first sheet.
This works without copy paste and selecting or activating cells / sheets.
Also if you specify your sheet with the source data, like i did, it doesn't even matter which sheet you start the macro from.
Sub Copiar()
Dim range1 As Range
Set range1 = Sheets(1).Range("K56:K58")
For Each cell In range1
If cell.Value = Sheets(1).Range("R55").Value Then
Sheets("Plan2").Range("R" & cell.Row).Value = cell.Offset(0, 2).Value
End If
Next
End Sub
Related
I have a list of names, and some code that I would like to run for every single name.
What I'm starting with is this:
Dim cell As Range
For Each cell In Worksheets("Reference").Range("b2:b237")
[rest of my code here]
Next cell
The issue is, what I'm actually trying to do is:
Step 1) Select a name from a drop down list in cell A1
Step 2) There are a bunch of other cells with formulas that reference A1
Step 3) Run code
Step 4) Select next name from drop down list in A1, repeat Steps 2 & 3, until end of list.
Edit: I found something on an old thread that seems to work for what I'm doing:
Sub Macro1()
Sheets("Sheet2").Activate
Range("A1").Select
Do While True
If Selection.Value = "" Then
Exit Do
Else
Selection.Copy
Sheets("Sheet1").Activate
Range("A1").Activate
ActiveSheet.Paste
[rest of my code]
Sheets("Sheet2").Activate
Selection.Offset(1, 0).Select
End If
Loop
End Sub
This should do the job, but if anyone has a more efficient way rather than copying and pasting each value from the list to the cell, that would be very helpful too!
Thank you.
This will take each name in a range and put it into a cell sequentially - you will need to edit to put your sheetnames and ranges in
Sub LoopThroughNames()
dim RangeWithNames as range
'define list of names - needs editing
set RangeWithNames = Worksheets("othersheetname").Range("range with names")
dim TargetCell as range
set TargetCell = worksheets("Sheet with calcs").Range("A1") 'top sheet, cell A1 edit as needed
dim r as range
for each r in RangeWithNames
targetcell= r 'assign name into A1
'do your stuff
next r
End Sub
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.
I'll try (as best I can) to explain the code I'm using
Essentially I have an excel which outputs a value to cell W151 based on a calculation that depends on cells in the range Q149:Q182.
The first step is to reset all the values in the range Q149:Q182 to their base values by copying and pasting from cells S149:S182.
Based on the base values for the formula, I copy and paste the value outputted to W151 into W99
Next, I change the value in Q149 to "2". This updates the calculation and hence the value in cell W151 which I then copy and paste into W100
Then I change Q150 to "2" and again copy the value from W151, this time into W101 and so on and so forth
My question is, is there a way of setting the cells that i'm changing as an array (picked by the user through a prompt), the output cell W151 as a variable (picked by the user through a prompt) and the destination for the copied values (i.e. currently cells W99:W101) as an array also picked by the user via a prompt. If not is there any way you can think of that might automated this process?
I appreciate that I might have done a poor job explaining what I'm trying to do so please feel free to ask for clarifications (although I warn you my VBA knowledge is very limited)
Many Thanks,
Thomas
Sub Example()
Range("S149:S182").Select
Selection.Copy
Range("Q149").Select
Selection.PasteSpecial Paste:=xlPasteValues
Range("W151").Select
Selection.Copy
Range("W99").Select
Selection.PasteSpecial Paste:=xlPasteValues
Range("Q149").Select
ActiveCell.FormulaR1C1 = "2"
Range("W151").Select
Selection.Copy
Range("W100").Select
Selection.PasteSpecial Paste:=xlPasteValues
Range("Q150").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "2"
Range("W151").Select
Selection.Copy
Range("W101").Select
Selection.PasteSpecial Paste:=xlPasteValues
End Sub
Not quite the way I was hoping to do it as this still relies on putting values on the worksheet.
There's one step missing that I didn't understand:
Based on the base values for the formula, I copy and paste the value
outputted to W151 into W99
This is done before you turn the first value to 2. So is it a case of the base average goes into W99, then you change the first value to 2 and that goes into W100. i.e. If you start with 34 values in column Q you'll end with 35 values copied to column W?
Sub Test()
Dim CopyRng As Range
Dim rCell As Range
With ThisWorkbook.Worksheets("Sheet1")
Set CopyRng = .Range("Q149:Q182")
CopyRng.Value = .Range("S149:S182").Value
.Range("W99").Value = .Range("W151").Value
For Each rCell In CopyRng
rCell.Value = 2
'Q149 Offset by -49 rows and +6 columns = cell W100.
rCell.Offset(-49, 6).Value = .Range("W151").Value
Next rCell
End With
End Sub
Edit:
To ask the user to make the selections you could use the following method.
One problem that hasn't been addressed in this code is if the user presses Cancel, but hopefully the link will point you in the right direction - I liked the answer given by #DirkReichel.
Sub Test()
Dim CopyRng As Range
Dim rCalculation As Range
Dim rDestination As Range
Dim rCell As Range
'Creating the base values is a manual operation now.
'CopyRng.Value = Sheet1.Range("S149:S182").Value
Set CopyRng = Application.InputBox("Select range to be evaluated.", Type:=8) 'Q149:Q182
'Calculation must be a single cell.
Do
Set rCalculation = Application.InputBox("Select cell containing calculation.", Type:=8) 'W151
Loop While rCalculation.Cells.Count <> 1
'First cell in destination must be a single cell.
Do
Set rDestination = Application.InputBox("Select first cell to be pasted to.", Type:=8) 'W99
Loop While rDestination.Cells.Count <> 1
rDestination.Value = rCalculation.Value
For Each rCell In CopyRng
rCell.Value = 2
rDestination.Offset(rCell.Row - CopyRng.Row + 1).Value = rCalculation.Value
Next rCell
End Sub
You have lot of unnecessary things in your code simply use inputbox to get the range and use it as required.
Sub Example()
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = Application.InputBox("Select range1", Type:=8)
Set rng2 = Application.InputBox("Select range2", Type:=8)
With Sheets("Sheet1")
.Range("Q149:Q182").Value = rng1.Value
.Range("W99").Value = rng2.Value
.Range("Q149").FormulaR1C1 = "2"
.Range("W100").Value = rng2.Value
.Range("Q150").FormulaR1C1 = "2"
.Range("W101").Value = rng2.Value
End With
End Sub
#Thomas first of all welcome!
Make the necessary changes (Sheet name or ranges) and try:
Sub Example()
With (Sheet1) '<= Change Sheet Name if needed
.Range("S149:S182").Copy .Range("Q149")
.Range("W151").Copy .Range("W99")
.Range("W151").Copy .Range("W100")
.Range("W151").Copy .Range("W101")
.Range("Q149").value="2"
.Range("Q150").value = "2"
End With
End Sub
Please see below code I have found on the internet, which is currently working to a certain degree for me.
Could someone possibly commentate on what each line of this code means so I can understand what its doing?
Im trying to understand it with little programming knowledge and add additional code to look for additional values to paste into additional sheets.
I'm also trying to work out how to make them paste to certain rows one after the other and not maintain the row they were originally in on sheet 1.
Code:
Sub Test()
Dim rw As Long, Cell As Range
For Each Cell In Sheets(1).Range("H:H")
rw = Cell.Row
If Cell.Value = "Dept 1" Then
Cell.EntireRow.Copy
Sheets("Sheet2").Range("A" & rw).PasteSpecial xlPasteValues
End If
Next
End Sub
--
Many thanks
I've added comments as requested. To paste them onto the same row, look at removing the rw variable and replacing it with something that increments by one each time
Sub Test()
'declare variables
Dim rw As Long, Cell As Range
'loop through each cell the whole of column H in the first worksheet in the active workbook
For Each Cell In Sheets(1).Range("H:H")
'set rw variable equal to the row number of the Cell variable, which changes with each iteration of the For loop above
rw = Cell.Row
'check if the value of Cell variable equals Dept 1
If Cell.Value = "Dept 1" Then
'copy the entire row if above is true
Cell.EntireRow.Copy
'paste to the same row of Sheet 2
Sheets("Sheet2").Range("A" & rw).PasteSpecial xlPasteValues
End If
Next
End Sub
Here is your Code Commented hope you understand:
Sub Test()
' Variables Defined as follows:
Dim rw As Long, Cell As Range
' Loop Searching each Cell of (Range H1 to end of last H on sheet1
For Each Cell In Sheets(1).Range("H:H")
' now determine current row number:
rw = Cell.Row
' Test cell value if it contain >> Dept 1 as value:
If Cell.Value = "Dept 1" Then
' Select that row and copy it:
Cell.EntireRow.Copy
' now paste the values of that row into A column and rw row on sheet2:
Sheets("Sheet2").Range("A" & rw).PasteSpecial xlPasteValues
' You should add following to:
' Disable marching ants around copied range:
Application.CutCopyMode = False
End If
Next
End Sub
I'm trying to paste info to the first blank cell in colum A of a sheet? How can I do this?
This is what I have done but it paste the info 1000 times. What do I need to change?
Thanks in advance.
Range("B2:E2").Select 'Selet info to copy
Selection.Copy 'Copy
Sheets(Range("A2").Value).Select 'Goto Sheet Listed in cell A2
Dim i 'define i
For i = 3 To 1000 'Set up loop size
If Range("A" & CStr(i)).Value = "" Then 'If Cell Ai is blank
Range("A" & i).Select
ActiveSheet.Paste 'Paste info
End If
Next i
End If
While modifying the loop with an Exit For will work, there is a much better approach - finding the last cell in a column can be achieved with
Set lastCell = Range("A1").End(xlDown)
set freeCell = lastCell.Offset(1,0)
This assumes that there is at least one cell below A1. If you know (as in your example) that there will never be more than 1000 rows occupied, you can do this in the other direction:
Function freeCell(r As Range) As Range
' returns first free cell below r
Dim lc As Range ' last used cell on sheet
Set lc = r.Offset(1000, 0).End(xlUp).Offset(1, 0)
Set freeCell = lc
End Function
Sub testIt()
Dim p As Range
Set p = freeCell(Range("A3"))
MsgBox "the address of p is " & p.Address
End Sub
The function freeCell returns the cell you are after; the sub testIt shows that it works (and how it is called). In your case, you can greatly simplify your code to
Sub doIt()
Dim sh As Worksheet, tCell As Range
Sheets("Sheet1").Range("B2:E2").Copy
Set sh = Sheets(Range("A2").Value)
Set tCell = freeCell(sh.Range("A3"))
sh.Paste tCell
End Sub
Note - when you record a macro, you get lots of Activate, Select etc commands sneaking in. These can usually be avoided - and there are plenty of excellent articles online (and on this site) explaining why you would want to avoid them. The above snipped shows how to copy from one sheet to another without any of these.
If you are never sure that there is anything on your target sheet (no header row in row 2, for example) you could modify your code so the target cell is never above row 3:
If tCell.Row < 3 Then Set tCell = tCell.Offset(3 - tCell.Row)
Your FOR LOOP will run from cell A3 until A1000 and for every empty cell it will paste the value. You want to exit your loop as soon as the condition is matched. You want to add an Exit For condition.
If Range("A" & CStr(i)).Value = "" Then
Range("A" & i).Select
ActiveSheet.Paste
Exit For
End If
Source