This question already has answers here:
Finding first blank row, then writing to it
(8 answers)
Closed 6 years ago.
I would like to copy selected row from Sheet1 to Sheet2. Below code is overriding existing value in Sheet2 file. Please assist to stop override my existing values.
Sub CopySelection()
Dim xlSel As Excel.Range
Set xlSel = Excel.Application.Selection
xlSel.Copy Excel.Application.Sheets("All_Data").Range("A1")
End Sub
Any help will be appreciated.
The code below will copy the range selected in "Sheet1" (modify it to fit your sheet's name that holds the data to be copied), and then will paste it in Column A in the first available row in Sheet "All_Data".
Let me know if the code below (tested) works :
Sub CopySelection()
Dim Sht1 As Worksheet
Dim Sht2 As Worksheet
Dim xlSel As Range
Dim LastRow As Long
' modify "Sheet1" to your sheet source (where you make your Selection to copy)
Set Sht1 = ThisWorkbook.Sheets("Sheet1")
' sheet "All_Data" is your target sheet (Where you paste the selection)
Set Sht2 = ThisWorkbook.Sheets("All_Data")
Set xlSel = Selection
'option 1: find last row with data in Sheet "All_Data" at Column A
LastRow = Sht2.Cells(Sht2.Rows.Count, "A").End(xlUp).Row
'option 2: (less reliable) find last row with data in Sheet "All_Data" using UsedRange
'LastRow = Sht2.UsedRange.Rows(Sht2.UsedRange.Rows.Count).Row
' paste the copied range in Column A, the first row after row with data
xlSel.Copy Sht2.Range("A" & LastRow + 1)
End Sub
Related
sorry guys I am conscious this is really simple but its been very frustrating trying to figure this out last hour.
I would like to have the value "427" (Column D) go all the way down to the end of the last line of range. (Row 32) As it is a dynamic range, the range will have new entries over time. I used the following code to do it
Sub EnterRemainingValues()
Dim Workbook As Workbook
Dim lastrow As Long
Set Workbook = Workbooks("Workbook 1") 'name of workbook
lastrow = Worksheets("Sheets1").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Sheet1").Range("D14:D" & lastrow).Value = "427"
The issue I believe i'm having is because the range starts from A13 rather than A1, so the values 427 only fill up the first 3 rows which corresponds to the height of the worksheet title (A1:A3). The code thinks thats the lastrow. What I would like is to fill column D with "427" all the way down to the last row starting from row 14. Thank you
EDIT: I forgot to mention - I am controlling "workbook1" which contains the range pictured from a different workbook ("workbookfinal")
Try this:
Option Explicit
Sub EnterRemainingValues()
' Define workbook.
Dim wb As Workbook ' You might need to use '.xlsm'
Set wb = Workbooks("Workbook 1") ' name of workbook
' Define worksheet.
Dim ws As Worksheet
Set ws = wb.Worksheets("Sheet1")
' Calculate last row.
Dim lastrow As Long
lastrow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
' Write values.
ws.Range("D14:D" & lastrow).Value = "427"
End Sub
I have code to copy a Worksheet A, columns A:C (no set row quantities, this will be re-used and the quantities will change) and paste to the first blank row in the same workbook, different sheet, Worksheet B (this also has no set row quantities and will change).
Worksheet B has a formula in the same columns that I want to paste to that returns "" if there is no data. I think VBA is seeing the "" and assuming there is data there; however, it is not pasting even to lines without said formula.
Sub Copy_Created_Fringe_Accounts()
Dim SourceRange As Range
Dim DestRange As Range
Dim DestSheet As Worksheet
Dim LastRow As Long
'Source sheet and range
Set SourceRange = Sheets("CREATED FRINGE ACCTS").Range("A2:C500")
'Destination sheet and range
Set DestSheet = Sheets("99 BUDGET WORKSHEET")
'Last Row
LastRow = DestSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'Copy and paste to destination
Set DestRange = DestSheet.Range("A" & LastRow + 1)
SourceRange.Copy DestRange
End Sub
Nothing happens when I run it. I expect to see the data from Worksheet A copied to Worksheet B, starting at the first available empty row.
I am fairly new to VBA so any help/understanding is appreciated.
Finding the last row
Try using UsedRange to find the last used row as this is safer than using Find.
LastRow = DestSheet.UsedRange.Rows.Count
A side note
If your code resides in the same place as these worksheets then I would recommend using their code name. This will protect you from running into an error if the sheet doesn't exist.
I had a VBA code that copies data entered in row 3 to the last empty row in a table that is found in the same sheet. This copying is triggered once a button a clicked.
This was working fine with the code below:
Sub copyRow()
Dim ws As Worksheet
Dim lRow As Long
' define which worksheet to work on, i.e. replace Sheet1 with the name of
your sheet
Set ws = ActiveWorkbook.Sheets("Record ClientsDetails")
' determine the last row with content in column D and add one
lRow = ws.Cells(Rows.Count, "D").End(xlUp).Row + 1
' copy some cells into their ranges
ws.Range("D3:F3").Copy ws.Range("D" & lRow)
ws.[D1].Select
I have made inserted a new row before column D to the spreadsheet, but the button is not copying anymore, even after adjusting the code. I am getting an error msg:
Run-time error '1004'
Copy method of Range class failed
The new code is:
Sub copyRow()
Dim ws As Worksheet
Dim lRow As Long
' define which worksheet to work on, i.e. replace Sheet1 with the name of your sheet
Set ws = ActiveWorkbook.Sheets("Record ClientsDetails")
' determine the last row with content in column D and add one
lRow = ws.Cells(Rows.Count, "D").End(xlUp).Row + 1
' copy some cells into their ranges
ws.Range("D3:G3").Copy ws.Range("D" & lRow)
ws.[D1].Select
The error is occurring on this line:
' copy some cells into their ranges
ws.Range("D3:G3").Copy ws.Range("D" & lRow)
ws.[D1].Select
The new row that I inserted has a data validation in it (i.e. now D3 has a data validation). Could this be the reason why the button is not copying Row 3 anymore? When the code was working before inserting the row, D3 did not have a data validation.
I am writing a macro that loops through a "source" sheet and for each value in column A, copy a range from template sheet to a destination sheet. After the template range is copied, I need to change a few values in destination sheet based on the source sheet value. Right now I am trying to get the copy working. The copy is failing with error 1004 'The information cannot be pasted because the Copy area and the paste area are not the same size.'
Sub CopyRangeFromOneSheetToAnother()
Dim iLastRow As Long
Dim wb As Workbook
Dim shtSource As Worksheet
Dim shtTemplate As Worksheet
Dim shtDest As Worksheet
Dim sResourceName
Dim rngCalcTemplate As Range
Set wb = ThisWorkbook
Set shtSource = wb.Sheets(1)
Set shtTemplate = wb.Sheets("res_tpl")
Set shtDest = wb.Sheets.Add
'--set range for copying. Hard-coded for now would be nice if it would auto shrink/expand
Set rngCalcTemplate = shtTemplate.Range("A2:M7")
'Find the last row (in column A) with data.
iLastRow = shtSource.Range("A:A").Find("*", searchdirection:=xlPrevious).Row
'--loop through source sheet and copy template range to dest for each
For iSourceSheetRow = 2 To iLastRow
sResourceName = shtSource.Cells(iSourceSheetRow, 1)
rngCalcTemplate.Copy shtDest.Range("A" & Rows.Count).End(xlDown)
Next
End Sub
The problem is with the following line of your code:
rngCalcTemplate.Copy shtDest.Range("A" & Rows.Count).End(xlDown)
If you place your cursor at the very last cell in column A (i.e. at "A" & Rows.Count, possibly A1048576) and then press Ctrl-Down, you are still at the very last cell in column A.
If you then try to paste 6 rows of information starting at that cell, there won't be room to do so - there is only one row of "pastable" area to use.
You are probably wanting to find the row following the last used cell in that column, so your code should be:
rngCalcTemplate.Copy shtDest.Range("A" & shtDest.Rows.Count).End(xlUp).Offset(1, 0)
I have a workbook filled with text-based data on several different sheets. All the sheets use the same headings, but have different text in the columns. I would like to be able to list the information contained in the column C from all of the sheets in a single column in a new sheet.
Is there a way to get all of that data into a single column without having to copy and past from nearly 100 different sheets?
Using VBA, here is a solution that works. You just need to insert a module into your workbook and run this. F11 > Insert > Module. Copy and paste this code, and hit play.
This will create a new worksheet with whatever name you define under newSheet. Then take the contents of EVERY worksheet Row C (after header), no matter how many you have or what their name is, and add them to the new one. I could see a problem if you exceed 1,000,000 rows.. Other than that, if there are any sheets you DON'T want to perform this on, we would add them as exceptions specifically by name in the If statement.
TESTED:
Private Sub CopyAllSheetsCol()
Dim WS As Worksheet
Dim newSheet As String
Dim lastRow As Long 'Last Row on source Sheet
Dim tRow As Long 'target row
newSheet = "Compiled" 'name can be changed here
Sheets.Add.Name = newSheet
tRow = 2 'Set the target Row to 2, Set the Header Row manually
For Each WS In ActiveWorkbook.Worksheets
If WS.Name <> newSheet Then 'Making sure we are only working with pre-existing sheets
lastRow = Sheets(WS.Name).Range("C2").End(xlDown).Row 'get last row of Column C on each Worksheet
For r = 2 To lastRow 'Loop through all rows skipping header
Sheets(newSheet).Cells(tRow, "C") = Sheets(WS.Name).Cells(r, "C") 'Copy to newSheet
tRow = tRow + 1 'Increment target row by 1
Next r
End If
Next
End Sub
edit: touched up explanation