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
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,
could someone help modify this code so instead of only looking if within Column A is a blank cell it instead looks for example from A to M?
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("New-Data.xlsx").Worksheets("Export 2")
Set wsDest = Workbooks("Reports.xlsm").Worksheets("All Data")
'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)
'Optional - Select the destination sheet
wsDest.Activate
End Sub
Find the Last Non-Empty Row of a Range By Using the Find Method
It should be lDestFirstRow.
'2. Find first empty row in the destination range based on data in columns A:M
Dim lCell As Range: Set lCell = wsDest.Columns("A:M").Find("*", , xlFormulas, , xlByRows, xlPrevious)
If lCell Is Nothing Then lDestLastRow = 1 Else lDestLastRow = lCell.Row + 1
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
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.