How to copy a range of excel cells to another sheet every time the source values change?
This code below is working to copy and append on the next sheet. It needs 2 things:
execute when value in sheet 1 refreshes
paste special the values only on sheet 2
Thanks
Sub Copy_Paste_Below_Last_Cell()
'Find the last used row in both sheets and copy and paste data below existing data.
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
'Set variables for copy and destination sheets
Set wsCopy = Workbooks("metrics.xlsm").Worksheets("Sheet1")
Set wsDest = Workbooks("metrics.xlsm").Worksheets("Sheet2")
'1. Find last used row in the copy range based on data in column A
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
'2. Find first blank row in the destination range based on data in column A
'Offset property moves down 1 row
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
'3. Copy & Paste Data
wsCopy.Range("A2:D" & lCopyLastRow).Copy _
wsDest.Range("A" & lDestLastRow)
End Sub
You can use the event Worksheet_TableUpdate for this use. The documentation.
Related
When I append data to another sheet with this code, some data is replaced when the range is uneven (i.e., one column has more data than another column). The last row is only based on one column, but I would need it to be based on 2 columns. How can I do this? Thank you!
Sub CopyData()
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
Dim lDestLastColumn As Long
Set wsCopy = Sheets("CopyFrom")
Set wsDest = Sheets("PasteHere")
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row
wsCopy.Range("C3:F20").Copy
wsDest.Range("B" & lDestLastRow).PasteSpecial
'Copy & Paste Date
wsCopy.Range("B1").Copy
wsDest.Range("A" & lDestLastRow).PasteSpecial
End Sub
Add another variable to store another column's length (I call it tempLrow), and then pick the highest value.
In the below answer I've used column A as the example but you could substitute in any other column - or do the same multiple times to get the maximum length across more different columns.
Sub CopyData()
Dim wsCopy As Worksheet, wsDest As Worksheet
Dim lCopyLastRow As Long, lDestLastRow As Long, lDestLastColumn As Long, tempLRow as Long
Set wsCopy = Sheets("CopyFrom"): Set wsDest = Sheets("PasteHere")
'Last row of column B:
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row
'Last row of column A:
tempLRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
' if column A is longer than column B, update lDestLastRow to suit:
If tempLRow > LDestLastRow Then LDestLastRow = tempLRow
wsCopy.Range("C3:F20").Copy Destination:=wsDest.Range("B" & lDestLastRow)
'Copy & Paste Date
wsCopy.Range("B1").Copy Destination:=wsDest.Range("A" & lDestLastRow)
End Sub
I have the following code and would like to change it so that if the cells from A2 to H2 are empty in Sheet1 then the macro doesn't do anything (it's part of a larger sub so I don't want to exit sub completely), however, if there is anything in these cells than the macro is executed.
This is my current code, the problem that I have is that it copies the area under the headers of a table and if the area is empty then it copies the headers.
Sub Macro36()
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
'Set variables for copy and destination sheets
Set wsCopy = Worksheets("Sheet1")
Set wsDest = Worksheets("Sheet2")
'1. Find last used row in the copy range based on data in column 1
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.count, "A").End(xlUp).Row
'2 Find first bnak row in the destination range based in column A
lDestLastRow = wsDest.Cells(wsDest.Rows.count, "B").End(xlUp).Offset(1).Row
'3. Copy & Paste Data
wsCopy.Range("A2:H" & lCopyLastRow).Copy wsDest.Range("B" & lDestLastRow)
End Sub
This is my attempt to change the code by adding if function, however, the macro is still executed even though cells A2:H2 in Sheet 1 are empty.
Sub Macro36()
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
'Set variables for copy and destination sheets
Set wsCopy = Worksheets("Sheet1")
Set wsDest = Worksheets("Sheet2")
'1. Find last used row in the copy range based on data in column 1
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.count, "A").End(xlUp).Row
'2 Find first bnak row in the destination range based in column A
lDestLastRow = wsDest.Cells(wsDest.Rows.count, "B").End(xlUp).Offset(1).Row
'If function
If IsEmpty(Sheets("Sheet1").Range("A2:H2")) = False Then
'3. Copy & Paste Data
wsCopy.Range("A2:H" & lCopyLastRow).Copy wsDest.Range("B" & lDestLastRow)
Else
Range("A1").Select
End if
End Sub
I was wondering how I could change the code?
Thanks,
I'm trying to make something in Excel work, but I cannot.
I have 2 Sheets
Sheet 1 is the "main sheet"
Sheet 2 has a filter.
I want 2 filtered columns to be copied to the main sheet and pasted at the end of the already existing content.
Try this - you will need to update the ranges/sheet names as required.
Sub CopyDataLastRow()
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim CopyLastRow As Long
Dim DestLastRow As Long
'Set Variables
Set wsCopy = Sheets("Sheet1") 'Update your sheet name as required.
Set wsDest = Sheets("Sheet2") 'Update your sheet name as required.
'Find Last Row in Copy Range
CopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
'Find 1st blank row in Destination Range - Offset 1 row
DestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
'Copy & Paste Data
wsCopy.Range("A2:B" & CopyLastRow).Copy _
wsDest.Range("A" & DestLastRow)
End Sub
My goal is to copy and paste from one workbook to another, but I want to have dynamic names - now are statitic and declared in code.
From the code below is visible how it is set now. How can i change my code so these names will be automatic based on the cell (eg.: destination now is "ToThere.xslx" to a value that is in a cell "O2")
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
Dim Name as Short
Name = Range("O2").Value
'Set variables for copy and destination sheets
Set wsCopy = Workbooks("FromHere.xlsm").Worksheets("List1")
' I would like this part here to be: Workbooks(Name).Worksheets("List1")
Set wsDest = Workbooks("ToThere.xlsx").Worksheets("List1")
'1. Find last used row in the copy range based on data in column A
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
'2. Find first blank row in the destination range based on data in
column A
'Offset property moves down 1 row
lDestLastRow = wsDest.Cells(wsDest.Rows.Count,
"A").End(xlUp).Offset(1).Row
'3. Copy & Paste Data
wsCopy.Range("A2:H" & lCopyLastRow).Copy _
wsDest.Range("A" & lDestLastRow)
Here's your example
Sub test()
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
Dim Name As Integer
Name = Range("O2").Value
'Set variables for copy and destination sheets
Set wsCopy = Workbooks("FromHere.xlsm").Worksheets("List1")
' I would like this part here to be: Workbooks(Name).Worksheets("List1")
Set wsDest = Workbooks("ToThere.xlsx").Worksheets("List1")
'1. Find last used row in the copy range based on data in column A
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
'2. Find first blank row in the destination range based on data in
'Column A
'Offset property moves down 1 row
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
'3. Copy & Paste Data
wsCopy.Range("A2:H" & lCopyLastRow).Copy
ActiveSheet.Paste Destination:=wsDest.Range("A" & lDestLastRow)
End Sub
I'm looking to select cells with values from a dynamic table, and copy and paste these values into another worksheet with a table where the next empty cell is available.
I've only been able to find code that will copy and paste a defined range into the next empty cell or copy and paste a dynamic range with some values and empty cells.
Sub SaveKit_1()
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopy As Long
Dim lDest As Long
Set wsCopy = Worksheets("Kit_db") 'Copies table from Kit_db worksheet
Set wsDest = Worksheets("Kit_db (1)") 'Pastes table to Kit_db (1) worksheet
lCopy = wsCopy.Cells(wsCopy.Rows.Count, "E").End(xlUp).Row
lDest = wsDest.Cells(wsDest.Rows.Count, "E").End(xlUp).Offset(1).Row
'Copies any cell within the table
wsCopy.Range("B3:I" & lCopy).Copy _
wsDest.Range("B" & lDest)
End Sub
All cells in the dynamic table are copied and pasted rather than the cells in the table with values. I'm looking to paste values only as some cells in the dynamic table have formulas.
I have tried the following Paste Special
PasteSpecial _
Paste:=xlPasteValuesAndNumberFormats, _
Operation:=xlPasteSpecialOperationNone, _
SkipBlanks:=True, _
Transpose:=False
But I don't think I placed it correctly with the existing code or I'm using the wrong type of code for paste.
Here is an example of paste special as values with your code
Sub SaveKit_1()
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopy As Long
Dim lDest As Long
Set wsCopy = Worksheets("Kit_db") 'Copies table from Kit_db worksheet
Set wsDest = Worksheets("Kit_db (1)") 'Pastes table to Kit_db (1) worksheet
lCopy = wsCopy.Cells(wsCopy.Rows.Count, "E").End(xlUp).Row
lDest = wsDest.Cells(wsDest.Rows.Count, "E").End(xlUp).Offset(1).Row
'Copies any cell within the table
wsCopy.Range("B3:I" & lCopy).Copy
wsDest.Range("B" & lDest).PasteSpecial xlPasteValues
End Sub