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
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 tried to use my other similar VBA code but I don't think I understand what I'm trying to replace for the range. In this code, I am trying to copy the data in the Repeating Items sheet in the fourth column with the cell value of 12, then paste it to the last worksheet.
' Repeating items worksheet
Worksheets("Repeating Items").Select
ActiveSheet.ShowAllData
b = Worksheets("Repeating Items").Cells(Rows.Count, 1).End(xlUp).Row
' Filters the data where column 2 equals to 12 to x. ** this is where the error starts
ActiveSheet.Range(Cells(1, 1), Cells(b, 4)).Autofilter Field:=4, Criteria1:="12", Operator:=xlFilterValues
' Selects only the filtered cells and copy
Range(Cells(2, 1), Cells(b, 4)).SpecialCells(xlCellTypeVisible).Select
Selection.Copy
ThisWorkbook.Worksheets(ThisWorkbook.Sheets.Count).Select
ActiveSheet.Paste Destination:=Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
Per the Microsoft Documentation, you can just apply the filter to the first row much how you would manually do in excel and it will automatically filter your range. You don't need to quote your number filter FYI (unless the column is Text).
Also, no need to Select anything here. It is just a middle man operator that only slows your code down. Instead, explicitly define your objects (sheets and ranges) and skip right to the action statements (copy/paste).
Sub Test()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Repeating Items")
Dim ls As Worksheet: Set ls = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Dim lr As Long
lr = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
ws.Range("A1:D1").AutoFilter Field:=4, Criteria1:=12
ws.Range("A2:D" & lr).SpecialCells(xlCellTypeVisible).Copy
ls.Range("A" & ls.Range("A" & ls.Rows.Count).End(xlUp).Row).PasteSpecial xlPasteValues
End Sub
In advance, I would like to thank anyone who reads this for taking the time to make any suggestions! I have tried other examples I've found on here and none of them seem to work so thanks for any advice!
So essentially I have 3 sheets. In sheet 1, I will be manually entering data into the next empty row (The data spans from Column A to Column U). Sheet 2 is linked to Sheet 1 in a manner to where if I select a row and autofill down to the next one, it will display the data from Sheet 1 (and also increases the values in each cell to account for inflation).
So essentially after I enter data into a new row on Sheet 1, I want to run a macro that will then dynamically autofill the last row on Sheet 2 to the next empty row. I also want this to be repeated going from Sheet 2 to Sheet 3.
An example would be, if Sheet 1 and 2 both have data down to row 35, I want to be able to manually enter data in row 36 and then my macro will autofill row 35 to 36 on Sheet 2.
The code I have written so far is below. To explain, base/basee and home/homee are cells I have named to compare values from specific columns for my if/then statement. I keep getting Error 1004 on the last line where I try and autofill down to the next cell wit Offset(1,0)
Sub PracticeTool()
Dim current1 As Integer
Dim current2 As Integer
Worksheets("City1").Select
Application.Goto Reference:="base"
Selection.End(xlDown).Select
Selection.End(xlDown).Select
current1 = Selection
Worksheets("Inflation").Select
Application.Goto Reference:="basee"
Selection.End(xlDown).Select
Selection.End(xlDown).Select
current2 = Selection
If (current1 <> current2) Then
Application.Goto Reference:="homee"
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.AutoFill Destination:=Selection.Offset(1, 0), Type:=xlFillDefault
End If
End Sub
Sheet 1 Sample Data: https://i.stack.imgur.com/pTFo5.png
Sheet 2 Sample Data: https://i.stack.imgur.com/kufrV.png
I didnt't get exactly what you wanted to compare, but I think you're close.
This code should solve the requirement.
Read the comments and adjust it to fit your needs.
Public Sub AutoFillSheets()
AutoFillRange "Sheet2", "A", "U"
AutoFillRange "Sheet3", "A", "U"
End Sub
Private Sub AutoFillRange(ByVal targetSheetName As String, ByVal fromColumnLetter As String, toColumnLetter As String)
Dim targetSheet As Worksheet
Dim targetRange As Range
Dim targetLastRow As Long
Set targetSheet = ThisWorkbook.Worksheets(targetSheetName)
' Get the last row in source sheet
targetLastRow = targetSheet.Cells(targetSheet.Rows.Count, 1).End(xlUp).Row
' Set the range to copy
Set targetRange = targetSheet.Range(fromColumnLetter & targetLastRow & ":" & toColumnLetter & targetLastRow)
' You had the error in this line (below). Problem is that to use autofill you need to include the rows from which Excel would calculate the source range (see that I took the last row in the first column, and added one to the second column)
targetRange.AutoFill Destination:=targetSheet.Range(fromColumnLetter & targetLastRow & ":" & toColumnLetter & targetLastRow + 1)
End Sub
What I'm trying to do is open one workbook, copy all the data on the first sheet of it and then adding that data to the first empty row of a sheet in another workbook. I seem to run into a problem when pasting the data but I don't fully understand why. I have run the code and just copied the top row of a sheet and then used my method of finding the first empty row and pasting it there which has worked, so I must be something with how I'm copying / selecting my date.
Here is the code :
MyFile6.Activate
MyFile6.Worksheets(1).Activate
Cells.Select
Selection.Copy
Windows("Frávikagreining.xlsm").Activate
Sheets("Laun").Select
Dim Rng As Long
Rng = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(Rng, 1).Select
ActiveSheet.Paste
I have already defined and opened the workbook "MyFile6" (code not shown here). So I copy the data on the first sheet of this workbook MyFile6, then I open the sheet "Laun" at another workbook, find the last used row in column A, go one further down (first empty cell) and select that. But then my paste attempt is stopped by an error.
Any help / better way to do this would be greatly appreciated !
Cells.Select
Selection.Copy
You are getting that error because you are copying ALL Cells but not pasting in A1. And hence the error. You are trying to fit a bigger object into a smaller object. Work with realistic range objects instead of All Cells by finding last row in first sheet as well and then identifying the range to copy and then pasting accordingly.
Also avoid the use of .Select/Activate. You may want to see How to avoid using Select in Excel VBA
Your code can be written as (UNTESTED)
Dim lRow As Long, lCol As Long
Dim rngToCopy As Range
Dim thatWb As Workbook
'~~> Destination Workbook
Set thatWb = Workbooks("Frávikagreining.xlsm")
With MyFile6.Worksheets(1)
'~~> Find last row and column
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
'~~> Set your range to copy
Set rngToCopy = .Range(.Cells(1, 1), .Cells(lRow, lCol))
End With
With thatWb.Sheets("Laun")
'~~> find last row in destination sheet for pasting
lRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
'~~> Copy and paste
rngToCopy.Copy .Range("A" & lRow)
End With
I have a code that finds the last row of data in column E and selects the column to that last row. I want to be able to select associated data in columns B through D that goes with column E and then sort based on column B. So I thought I would just find the last row in column E then resize by 3 columns and sort from that selection but I keep getting a run-time error 1004 application-defined or object-defined error. I have provided the code I'm using below. Columns B through D contain data past the end of column E. Thanks!
ws.Range("E1:E" & finalrow).Resize(0, 3).Select
You may not always be starting in the first row (e.g. E1) so lastRow may not be applicable without some maths. In that case, use With ... End With statements to shorten the code while explicitly referencing the correct cell and cell ranges.
dim lastRow as long
with ws
lastRow = .cells(.rows.count, "E").end(xlup).row
'option 1
.range("B5:D" & lastRow).select
'option 2
with .range("E5:E" & lastRow)
.offset(0, -3).resize(.rows.count, 3).select
end with
'option 3
.range("E5", .cells(lastRow, "G")).offset(0, -3).select
end with
See How to avoid using Select in Excel VBA macros for more methods on getting away from relying on Range.Select and Range.Activate to accomplish your goals.
Something like:
Sub SelectLast3Cols()
Dim ws As Worksheet, lrow As Long
Set ws = Sheets("Sheet3")
lrow = ws.Range("E" & ws.Rows.Count).End(xlUp).Row
ws.Range("B1", ws.Range("D" & lrow)).Select
End Sub