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.


