Copy and append the data in particular range in Excel - excel

Question

I need to copy data from sheet1 (P25:Y103) to sheet2 within B63:K1562.
Sheet1 will have new data every time. This should be copied to sheet2.
In Sheet2, B1563:K65536 has been used for other details. So need to paste the data within that range and not overwrite the existing values.
I have code to copy the contents but it will overwrite the existing data.
Sub CopyDatetoSameWorkBook()
Dim rgSource As Range, rgDestination As Range, X As Range
Dim Length As Long
Length = Cells(25, 2).End(xlDown).Row
Set rgSource = ThisWorkbook.Worksheets("Sheet1").Range("P25:Y" & Length)
Set rgDestination = ThisWorkbook.Worksheets("Sheet2").Range("B63")
rgSource.Copy
rgDestination.PasteSpecial xlPasteValues
Set rgSource = ThisWorkbook.Worksheets("Sheet1").Range("Z25:AG" & Length)
Set rgDestination = ThisWorkbook.Worksheets("Sheet2").Range("N63")
rgSource.Copy
rgDestination.PasteSpecial xlPasteValues
ActiveWorkbook.Save
MsgBox "Sheet1 Data Has been copied to Sheet2 Tabsheet"
End Sub

Answer 1

Thanks for your answers. I could achieve the things with below mentioned source code.
We have formed the Table as Range then found the last row in that Table.
Sub CopyDatetoSameWorkBook()
Dim copyrange As Range
Dim rgSource As Range, rgDestination As Range, X As Range
Dim Length As Long
Length = Cells(25, 2).End(xlDown).Row
Set copyrange = LastRowInExcelTable("Sheet1", "Table1")
Set rgSource = ThisWorkbook.Worksheets("Sheet2").Range("P25:Y" & Length)
Set rgDestination = ThisWorkbook.Worksheets("Sheet1").Range("B" & copyrange.Row)
rgSource.Copy
rgDestination.PasteSpecial xlPasteValues
Set rgSource = ThisWorkbook.Worksheets("Sheet2").Range("Z25:AG" & Length)
Set rgDestination = ThisWorkbook.Worksheets("Sheet1").Range("N" & copyrange.Row)
rgSource.Copy
rgDestination.PasteSpecial xlPasteValues
ActiveWorkbook.Save
MsgBox "Sheet1 Data Has been copied to Sheet2"
End Sub
Function LastRowInExcelTable(mysheet As String, mytable As String) As Range
Dim cell As Range
Dim ws As Worksheet
Set ws = Sheets(mysheet)
'Assuming the name of the table is "Table1"
Set LastRowInExcelTable = ws.ListObjects(mytable).Range.Columns(2).Cells.Find("", SearchOrder:=xlByRows, SearchDirection:=xlNext)
ActiveWorkbook.Save
End Function

Answer 2

If you definitely know the range for 'Sheet1' I'd suggest not to use Length. You can select the range directly and copy only values of these sells.
Sub CopyDatetoSameWorkBook()
Dim rgSource As Range, rgDestination As Range, X As Range
Set rgSource = ThisWorkbook.Worksheets("Sheet1").Range("P25:R28")
Set rgDestination = ThisWorkbook.Worksheets("Sheet2").Range("B63")
rgSource.Copy
rgDestination.PasteSpecial
ActiveWorkbook.Save
MsgBox "Sheet1 Data Has been copied to Sheet2 Tabsheet"
End Sub

Answer 3

Please excuse me i am under immense cruelty where I currently work and trying to write to you. But I have got it to working exactly how you describe.
The final trick was to figure out a way of tricking excel to pasting into row 63 first instead of row 1 or row 2 (or elsewhere as it did at times). I was looking for a way to fool excel into treating row 63 as row 1 or row 2 (beneath the header) but there doesn't seem to be..
I had got the continuous pasting right with no errors, but setting it from row 63 in the first instance was leading me stuck. It worked fine from row 1 or 2, and appending itself, or indeed from anywhere else it started, but couldn't figure out a dynamic adaptable solution for the starting row.
One trick I realized is just to check if sheet2 is empty or not. And to split the pasting by that condition: to check if Sheet2 is empty or not. For that I am checking if B63 (or similar) already has data in or not (is blank or IsEmpty). That was it.
I thought there was an easy isblank test for a sheet in excel which would be easier (and sorted us out quickly no problem), but again there isn't. Doesn't seem to be. Best and closest alternative is to check if cell B63 is empty or not, or adapt one of these functions and loops for your purposes Here , Here , Here and Here. as ive also done.
So now the whole process you want works as you want. I've tested numerous times, with changing sheet1 data and running, growing and changing the table-ranges data to paste, and running again and again to make sure it work. etc etc. It builds/grows your insert table in sheet 2 from row 63 onwards without hassle. It works to a tee.
Also prior, I had to change your last rows, as it was wasn't selecting the sheet1 data correctly. (xlCellTypeLastCell).Row works far better.
Now it works as you want.
I've also done a version with If Application.WorksheetFunction.CountA("B63:S64") = 0 Then which works better to check if a range is blank and decide where or if not to paste the data. CountA tests if the range B63:...wherever you want, has or hasn't got anything in it, and pastes sheet1 date into sheet2 from row63 if true, or appends to the end of the last filled row in sheet2 otherwise.
Sub CopyDatetoSameWorkBook13()
Dim rgSource As Range, rgDestination As Range, X As Range
ThisWorkbook.Worksheets("Sheet2").Activate
ActiveSheet.Cells(2, 63).Select
Dim Length As Long
'Length = 0 does nothing changes nothing
Length = ThisWorkbook.Worksheets("Sheet1").Cells(25, 2).SpecialCells(xlCellTypeLastCell).Row + 25
Dim length2 As Long
'length2 = 0 does nothing changes nothing
'length2 = 63 - ditto . absolute bs.
length2 = ThisWorkbook.Worksheets("Sheet2").Cells.SpecialCells(xlCellTypeLastCell).Row + 63
Set rgSource = ThisWorkbook.Worksheets("Sheet1").Range("P25:Y" & Length)
If IsEmpty(Range("B63").Value) = True Then
Set rgDestination = ThisWorkbook.Worksheets("Sheet2").Range("B63:K" & Length)
Else:
Set rgDestination = ThisWorkbook.Worksheets("Sheet2").Range("B" & 1 + length2 - 63) 'K
End If
rgSource.Copy
rgDestination.PasteSpecial xlPasteValues
Set rgSource = ThisWorkbook.Worksheets("Sheet1").Range("Z25:AG" & Length)
If IsEmpty(Range("N63").Value) = True Then
Set rgDestination = ThisWorkbook.Worksheets("Sheet2").Range("N63:S" & length2)
Else:
Set rgDestination = ThisWorkbook.Worksheets("Sheet2").Range("N" & 1 + length2 - 63) 'U
End If
rgSource.Copy
rgDestination.PasteSpecial xlPasteValues
Length = 0 '' dont think i need this any more
length2 = 0 '' ditto
ActiveWorkbook.Save
MsgBox "Sheet1 Data Has been copied to Sheet2 Tabsheet"
End Sub
'rgDestination.Range("N63:U" & sourcelastrow + 62).Value
you can replace the If-conditions, If IsEmpty(Range("B63").Value) = True Then and If IsEmpty(Range("N63").Value) = True Then , with :
If IsEmpty(Range("B63").Value) = True Then
and
If IsEmpty(Range("N63").Value) = True
for a more sturdy check.
Please test it and let me know if you need anything more or have any issues with it.
(Apologies for the very rushed child like message to you.)
Here is my screen shots and working to show you it works.

Answer 4

I like to use a FindRow to do it. It works by finding the first blank row and then the minus 1 represents the row above (the last row with data) so you may need to change the range to a column which will always be complete (like a unique identifier)
I move the data using destinationrange.value = sourcerange.value
I hope this makes sense but if you have any questions about what I've done, please let me know!
Sub CopyDatetoSameWorkBook()
Dim rgSource As excel.worksheet
dim rgDestination As excel.worksheet
dim X As Range
Dim Length As Long
Dim FindObject as object
Dim LastRow as long
Set rgSource = ThisWorkbook.Worksheets("Sheet1")
Set rgDestination = ThisWorkbook.Worksheets("Sheet2")
'find last row of sheet1
Set FindRow = rgSource.Range("P25:P100000").Find(What:="", LookIn:=xlValues)
LastRow = FindRow.Row - 1
'move the data from sheet1 to sheet2
rgDestination.range("B63:K" & lastrow + 62).value = rgSource.range("P25:Y" & LastRow).value
'Set rgSource = ThisWorkbook.Worksheets("Sheet1").Range("Z25:AG" & Length)
Set rgDestination = ThisWorkbook.Worksheets("Sheet2").Range("N63")
'find last row of sheet1
Set FindRow = rgSource.Range("Z25:Z100000").Find(What:="", LookIn:=xlValues)
LastRow = FindRow.Row - 1
'move the data from sheet1 to sheet2
rgDestination.range("N63:U" & sourcelastrow + 62).value = rgSource.range("Z25:AG" & LastRow).value
ActiveWorkbook.Save
MsgBox "Sheet1 Data Has been copied to Sheet2 Tabsheet"
End Sub

Answer 5

I don't know if you are still looking for a other answer, probably not , but as I couldnt get your code to work without a table, and also tried terrifiedjelly's - her versions didn't work, either the first time or the 2nd time, I kept at it.
But I got my version to work for your cases.
I'm finding the final filled row through a worksheet function to find the first blank cell in a range.
FinalRow = Evaluate("=MATCH(TRUE,ISBLANK(U63:U1563),0)+62")
And wrapping whole code in a if -final-available-row is still empty.
I used Destination sheet2 Column U to check, as in my test data that was the only column in my sheet1 with no blank cells in it (others did have blanks here or there - deliberrtely - for testing). So If all of your cells from your table in sheet1 are properly formatted and filled with something, no problem. But if they contain some empty cells, you need to check against a column that definitely does not contain a blank cell. Otherwise it will hilter-skew results and end up pasting source data in the wrong place. Something to bare in mind: Have atleast 1 properly formatted column
So, ensure the data your copying over has at atleast 1 column with no blank cells (or alternatively fill a helper column to the side of the editabe and growing table to denote table exists and check by that columns first blank cell). Otherwise you will have a problem. you could also concatonate your sheet1 table rows somewhere and check the first empty row value in such a off table column or array. Key is to check for first non blank cell by a column you are sure will always be filled or have data as its being produced/grows.
The whole thing works for me now - exactly as you want - as long as 1 column in the selection/ range/ table (Column U in my case) has no blank cells while your building 63 onwards.
So, Just wanted to inform you that Its working for me exactly as you want.
Sub CopyDatetoSameWorkBook15()
Dim rgSource As Range, rgDestination As Range, X As Range
ThisWorkbook.Worksheets("Sheet2").Activate
ActiveSheet.Cells(2, 63).Select
Dim Length As Long
Length = ThisWorkbook.Worksheets("Sheet1").Cells(25, 2).SpecialCells(xlCellTypeLastCell).Row + 25
Dim length2 As Long
length2 = ThisWorkbook.Worksheets("Sheet2").Cells.SpecialCells(xlCellTypeLastCell).Row + 63
FinalRow = Evaluate("=MATCH(TRUE,ISBLANK(U63:U1563),0)+62") '- important. Finds the first blank cell in range 63-1563
If IsEmpty(Range("B1564").Value) = False Then
MsgBox "Paste range is full. Please clear data and try again."
'i presume you anticipate filling until 1563 and that above 1563 you already have non empty filled cells . This will stop program when you fill the range or go over it.
'Could have used if countA 1563 row >0 instead. would be more robust.
Else:
Set rgSource = ThisWorkbook.Worksheets("Sheet1").Range("P25:Y" & Length)
If IsEmpty(Range("B63").Value) = True Then
Set rgDestination = ThisWorkbook.Worksheets("Sheet2").Range("B63:K" & Length)
Else:
Set rgDestination = ThisWorkbook.Worksheets("Sheet2").Range("B" & FinalRow) 'K ' + length2 - 63
End If
rgSource.Copy
rgDestination.PasteSpecial xlPasteValues
Set rgSource = ThisWorkbook.Worksheets("Sheet1").Range("Z25:AG" & Length)
If IsEmpty(Range("N63").Value) = True Then
Set rgDestination = ThisWorkbook.Worksheets("Sheet2").Range("N63:S" & length2)
Else:
Set rgDestination = ThisWorkbook.Worksheets("Sheet2").Range("N" & FinalRow) 'U ' + length2 - 63
End If
rgSource.Copy
rgDestination.PasteSpecial xlPasteValues
'Length = 0
'length2 = 0
ActiveWorkbook.Save
MsgBox "Sheet1 Data Has been copied to Sheet2 Tabsheet"
End If
End Sub
( Tomorrow I willsearch for a more robust worksheet function to check for last blank row in a 2d-range , so that I don't have to rely on a particular column; or just re-use the finalrow formula in a loop or with &'s over columns B to U which will do the trick)