This code works two or three times, and then I get a "PasteSpecial method of Range class failed" error. I know I get that error when nothing is copied, but considering it's copied right above, I don't understand why it's not working.
When I debug and watch it step by step, it loops back to the beginning after the Paste line, rather than running through the end of the Sub.
Sub AddRows()
Range("A11").End(xlDown).EntireRow.Copy
Range("A11").End(xlDown).Offset(1, 0).PasteSpecial xlPasteAll
Application.CutCopyMode = False
End Sub
Any ideas?
Thank you all in advance!
Try below code : The copy and paste operation can be combined in 1 line.
Below code copies the range from cell A11 till the last cell which has the data and paste the data in very next cell below.
Sub AddRows()
Dim lastRow As Long
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Dim rng As Range
Set rng = Range("A11:A" & lastRow)
' Next row
rng.Copy Cells(lastRow + 1, 1)
'if you want data to be pasted to Column B use below
'rng.Copy rng.Offset(0, 1)
End Sub
Related
This is currently the setup that I have found helpful and have modified to work well... However, I'm struggling with one small further and final modification. I would like to just - Paste Values as opposed to the Formulas.
Sub move_rows_to_another_sheet()
'
Sheets("User").Select
Columns("A:Y").Select
Range("A:Y").Activate
'
For Each myCell In Selection.Columns(25).Cells
If myCell.Value = "Closed" Then
myCell.EntireRow.Copy Worksheets("Archive").Range("A" & Rows.Count).End(3)(2)
myCell.EntireRow.Delete
End If
Next
'
Range("A2").Select
End Sub
''Updated Version - Move Single Rows
'
Sub move_rows_to_another_sheet()
'
Sheets("Users").Select
Columns("A:Y").Select
Range("A:Y").Activate
'
For Each mycell In Selection.Columns(25).Cells
'
If mycell.Value = "Closed" Then
mycell.EntireRow.Copy
Worksheets("Archive").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
mycell.EntireRow.Delete
End If
Next
'
Range("A2").Select
End Sub
The idea is simple... The current code is successful, however, I would like to just copy and paste the [values] of the rows cell content and [not] the formulas etc. The formatting is fine and everything, I just need the result of the functioning formulas recorded.
I have tried various options such as [myCell.EntireRow.CopyValues] even [& Rows.Count & Rows.PasteSpecial]... Any thoughts?
Thanks in advance
I tried your code. It looks like when there are several cells with "closed" it will not work for all. because when one deletes, one should delete from below upwards.
But then the data in Archive is not in right order.
In your original code you can make the range smaller, so it will run faster.
or take what you want from this code:
Sub move_rows_to_another_sheet2()
Dim mycell As Range
Dim checkClosed
Dim Lastrow As Long
Dim i As Long
Set checkClosed = ThisWorkbook.Worksheets("User").Range("Y1:Y10000")
Lastrow = Worksheets("Archive").Cells(Rows.Count, 1).End(xlUp).Row + 1 'one cell below last used cell in column A
For i = 10000 To 1 Step -1 'from row 10000 to row 1
Set mycell = ThisWorkbook.Worksheets("User").Cells(i, "Y")
If LCase(mycell.Value) = "closed" Then 'checks for Closed and closed
mycell.EntireRow.Copy
Worksheets("Archive").Range("A" & Lastrow).PasteSpecial Paste:=xlPasteValues
mycell.EntireRow.Delete
Lastrow = Lastrow + 1
End If
Next i
'
Range("A2").Select
End Sub
I am attempting a For Each loop using the below code.
Sub child_builder()
Dim cell As Range
For Each cell In ActiveSheet.Range("D5:D102")
If cell.Value = "Y" Then
cell.Activate
Selection.Offset(0, -2).Select
Selection.Copy
Sheets("Child").Select
ActiveSheet.Paste
Selection.Offset(0, 1).Select
ThisWorkbook.Sheets("Product Builder").Activate
Range("G6:I10").Select
Selection.Copy
Sheets("Child").Select
ActiveSheet.Paste
Selection.End(xlDown).Select
Selection.Offset(1, -1).Select
End If
Next cell
End Sub
The first loop works but then fails on the next one due to the line cell.activate.
The error is
Run-time error '1004': Activate method of Range class failed.
Maybe this will get you started, I know its tough to start rewriting the macro recorder stuff. Consider the comments in the code.
Sub child_builder()
Dim cell As Range
Dim RowToPasteTo As Long
RowToPasteTo = 1
For Each cell In ThisWorkbook.Sheets("PutTheNameOfYourSheetHere").Range("D5:D102")
If cell.Value = "Y" Then
'From the cell that has a Y in it, move left 2 columns and copy that to the A1 cell on the sheet "Child". Also consider just assigning a value with = if you dont need formats etc.
cell.Offset(0, -2).Copy ThisWorkbook.Sheets("Child").Range("A" & RowToPasteTo) 'Change the range here if you wanna paste somewhere else
'I am not sure what you are doing now but I assume you want to copy Range G6:I10 from the "Product Builder" sheet just to the right of the value we just copy pasted?
ThisWorkbook.Sheets("Product Builder").Range("G6:I10").Copy ThisWorkbook.Sheets("Child").Range("B" & RowToPasteTo) 'Change the range here if it needs to go somewhere else.
'From what I can tell you want to paste stuff just below what ever you just pasted on the next loop?
RowToPasteTo = RowToPasteTo + 5 'Move down 5 rows (because G6:I10 are 5 rows)
End If
Next
End Sub
I'm trying to write code to find the next free row in a work book to copy 4 cells of data from one workbook to another.
The code I've used works fine when I run it first time round (and there's nothing in the workbook). It selects A2 and pastes in the 4 cells of data. However when I try to run the same macro again, it selects B2, instead of A3?
I've used this function multiple times before but I've never seen anything like this before. My code is below.
'
' Macro6 Macro
'
Dim fRow As Long
With ActiveSheet
fRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Cells(fRow).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues
End With
End Sub
The issue is that Cells needs a row and column like .Cells(fRow, "A")
Option Explicit
Public Sub PasteRows()
With ActiveSheet
Dim fRow As Long
fRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Cells(fRow, "A").Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End With
End Sub
also don't use .Select it is a bad practice: You might benefit from reading
How to avoid using Select in Excel VBA.
Alternatively use the following which is even shorter:
Option Explicit
Public Sub PasteRows()
With ActiveSheet
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End With
End Sub
I simply need to grab a column (range) from one sheet, and append to another sheet. For some reason I keep getting an error 1004 - object/application defined error when trying to run the paste values function.
Any help would be appreciated.
Sub copycontactsiratotpsd()
Dim LastRowIRA2 As Long
Dim LastRowIRA As Long
Dim LastRowPOV As Long
Dim lastrow As Long
'activate source sheet
ActiveWorkbook.Worksheets("IRA").Activate
'copy from rev to ira AG to match # of rows for TPRM Contacts before appending
ActiveWorkbook.Sheets("Rev").Range("B2:B15000").SpecialCells(xlCellTypeVisible).Copy
ActiveWorkbook.Sheets("IRA").Range("AG2:AG15000").PasteSpecial xlPasteValues
'define last rows for all three instances
LastRowIRA = ActiveSheet.Range("A1").CurrentRegion.Rows.count
LastRowIRA2 = ActiveSheet.Range("AG1").CurrentRegion.Rows.count
lastrow = WorksheetFunction.Max(Sheets("TPD").Cells(Rows.count, "A").End(xlUp).Row)
LastRowPOV = ActiveWorkbook.Sheets("TPD").Range("A1").CurrentRegion.Rows.count
'if the number of lastrow in source sheet is equal to total VISIBLE last row within reference sheet then
If LastRowIRA = LastRowIRA2 Then
ActiveWorkbook.Worksheets("IRA").Activate
'copy the data needed, values are generally less than 10000 rows
ActiveWorkbook.ActiveSheet.Range("B2:B10000").Copy
ActiveWorkbook.Sheets("TPD").Range("A", lastrow).PasteSpecial xlPasteValues
'LINE WITH ERROR ABOVE
'else display msg for error handling
Else: MsgBox "Row Count is off! *CHECK*"
End If
ActiveWorkbook.Worksheets("IRA").Activate
Columns(33).EntireColumn.Delete
End Sub
To allow an answer to close this out:
ActiveWorkbook.ActiveSheet.Range("B2:B10000").Copy
ActiveWorkbook.Sheets("TPD").Cells(lastrow, "A").PasteSpecial xlPasteValues
Or:
ActiveWorkbook.ActiveSheet.Range("B2:B10000").Copy
ActiveWorkbook.Sheets("TPD").Range("A" & lastrow).PasteSpecial xlPasteValues
I'm very new to VBA and was hoping to get come clarification on a project. I've tried solving it with formulas but I need to still be able to enter information into cells and not have them filled with a lookup formula.
How I'm looking for it to preform is that if an object requires it to be shipped then the serial numbers and identifiers are copied and pasted in another table in the next blank row automatically.
Information divided into two tables
What I thought I needed was a segment in VBA that went like this:
Sub CopyCat()
If Range("J2") Like "*yes*" then
Range("G2:I2").copy
Range("A2:A10").end(xlup).offset(1).pasteSpecial xlpastevalues
If Range("J3") Like "*yes*" then
Range("G3:I3").copy
Range("A2:A10").end(xlup).offset(1).pasteSpecial xlpastevalues
End If
End If
End Sub
It does exactly what I ask it to do when it is only the first statement, when I add the second one to check if the next row satisfies the conditions and it does, then it places it in the same resulting cell as the first statement. If both are true I need them both to be displayed in table 1.
I'd love to take this as a learning opportunity so any information or direction you can point me in would be great! Thank you so much in advance!
I think Range("A2:A10").end(xlup) is equivalent to Range("A2").end(xlup) so will not change, but you don't want the A2 reference, you want to work up from the bottom. You will hit problems if you are going beyond A9. (Plus not sure you want nested Ifs.)
If Range("J2") Like "*yes*" Then
Range("G2:I2").Copy
Range("A10").End(xlUp).Offset(1).PasteSpecial xlPasteValues
End If
If Range("J3") Like "*yes*" Then
Range("G3:I3").Copy
Range("A10").End(xlUp).Offset(1).PasteSpecial xlPasteValues
End If
Or to add a loop and circumvent the copy/paste you could use something like this:
Sub CopyCat()
Dim r As Long
For r = 2 To Range("J" & Rows.Count).End(xlUp).Row
If Range("J" & r) Like "*yes*" Then
Range("A10").End(xlUp).Offset(1).Resize(, 3).Value = Range("G" & r).Resize(, 3).Value
End If
Next r
End Sub
You can also do this without VBA.
In A2, you can use this formula entered as an array formula with CTRL+SHIFT+ENTER:
=INDEX($G$2:$G$4,SMALL(IF($J$2:$J$4="yes",ROW($J$2:$J$4)-ROW($J$2)+1),ROWS(J$2:J2)))
And in B2, you can put this and drag down/over from B2:D3:
=INDEX(H$2:H$4,MATCH($A2,$G$2:$G$4,0))
Finally, to hide the errors that show when there are no more matches, you can simply wrap both above formulas in IFERROR([formula above],"").
With autofilter
Sub copyRange()
Dim wb As Workbook
Dim wsSource As Worksheet
Dim lastRow As Long
Dim filterRange As Range
Set wb = ThisWorkbook
Set wsSource = wb.Worksheets("Sheet2") 'change to sheet name containing delivery info
With wsSource
lastRow = .Cells(.Rows.Count, "G").End(xlUp).Row
Set filterRange = .Range("G1:K" & lastRow)
Dim copyRange As Range
Set copyRange = .Range("G2:K" & lastRow)
End With
Dim lastRowTarget As Long, nextTargetRow As Long
With filterRange
.AutoFilter
.AutoFilter Field:=4, Criteria1:="yes" 'change field to whichever is the field in the range containing your company names
lastRowTarget = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
nextRowTarget = lastRowTarget + 1
Union(wsSource.Range("G2:I" & lastRow).SpecialCells(xlCellTypeVisible), wsSource.Range("K2:K" & lastRow).SpecialCells(xlCellTypeVisible)).Copy wsSource.Range("A" & nextRowTarget)
.AutoFilter
End With
End Sub