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
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,
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
As shown the mocked-up table above, i'm trying write a macro that copies new data from another workbook (OtherWorkBook), then pastes it below the existing database (in ThisWorkBook).
After that, for only the new rows of data that was pasted, i want to shift the values in columns A, B, C, D one cell to the right. My current code works right until when it is supposed to move the columns, but then an error shows up.
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim CopyLastRow As Long
Dim DestLastRow As Long
Dim ToCopy As Range
Dim ToPaste As Range
Set wsCopy = Workbooks("OtherWorkBook").Worksheets("OtherWorkSheet")
Set wsDest = Workbooks("ThisWorkBook").Worksheets("ThisWorkSheet")
CopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "B").End(xlUp).Row
DestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row
wsCopy.Range("A2:V" & CopyLastRow).Copy _
wsDest.Range("A" & DestLastRow)
Set ToCopy = wsCopy.Range("A2:V" & CopyLastRow)
Set ToPaste = wsDest.Range("A" & PasteToLastRow)
ToCopy.Copy ToPaste
Set ToPaste = ToPaste.Resize(ToCopy.Rows.Count, ToCopy.Columns.Count)
ToPaste.Columns("A:D").Cut
'The debugger highlights this line of code
ToPaste.Columns("D").Insert Shift:=xlToRight
A macro recorder would not be feasible as the macro is periodically executed to add in new rows of data
You say move the values, so you could use Range.Value rather than Cut/Paste
Sub Demo()
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim CopyLastRow As Long
Dim DestLastRow As Long
Dim ToCopy As Range
Dim ToPaste As Range
Set wsCopy = Workbooks("OtherWorkBook").Worksheets("OtherWorkSheet")
Set wsDest = Workbooks("ThisWorkBook").Worksheets("ThisWorkSheet")
CopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "B").End(xlUp).Row
DestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row
' deleted redundant Copy/Paste here
Set ToCopy = wsCopy.Range("A2:V" & CopyLastRow)
Set ToPaste = wsDest.Range("A" & PasteToLastRow)
' copy the data
ToCopy.Copy ToPaste
' Resize ToPaste to the pasted rows, 4 columns
Set ToPaste = ToPaste.Resize(ToCopy.Rows.Count, 4)
' Move first 4 columns 1 column to right, leave formatting intact
ToPaste.Offset(, 1).Value = ToPaste.Value
' Clear the first column
ToPaste.Columns(1).ClearContents
End Sub
Try the following:
Columns("D").Cut
Columns("E").Insert Shift:=xlToRight
Columns("C").Cut
Columns("D").Insert Shift:=xlToRight
Columns("B").Cut
Columns("C").Insert Shift:=xlToRight
Columns("A").Cut
Columns("B").Insert Shift:=xlToRight
Unfortunately, don't have my Microsoft Office computer open to check whether this works, but you should be able to get the gist of my suggested solution from the above.
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.