VBA To Paste To Table First Row Moving Older Data Rows Below

[excelakos]

Hi dear All!!
I ve been searching around the web but no good luck so far. I need a macro if possible to allow me to always paste into a table's first row moving the old data below ( not overwriting them and expanding to keep all the old data plus the new data that occupied the first row)

Now the target table (where the new data should be pasted in 1st row) has 2 more columns in the right which include some functions.
The Pasted data are these 2 columns short

Feeder table = a pivot table from which i copy the data

Betakos Stake Calculator 1.3.1_Test.xlsm
	A	B	C	D	E	F	G	H	I	J
1
2		Match Day	PickNo	Match	Pick	Odds	Bookie	Final Stakes	Profit / Loss
3		1/2/2021	1	(blank)	(blank)	3,50	(blank)	10,00 €	25,00 €
4
5
6
7
8
9
10
Stakes

Target table = a table range named "t_StakeHistory"

Betakos Stake Calculator 1.3.1_Test.xlsm
	A	B	C	D	E	F	G	H	I	J	K
1
2
3
4		Match Day	PickNo	Match	Pick	Odds	Bookie	Final Stakes	Profit / Loss	Result	P/L
5		1/2/2021	1	(blank)	(blank)	3,50	(blank)	10,00 €	25,00 €	w	25,00 €
6
7
8
9
10
Stakes History

Cell Formulas
Range	Formula
K5	K5	=IF([@Result]="W",[@[Profit / Loss]],IF([@Result]="V",0,IF([@Result]="L",-[@[Profit / Loss]],"")))

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
B5:K5	Expression	=IF($J5="L";1;0)	text	NO
B5:K5	Expression	=IF($J5="V";1;0)	text	NO
B5:K5	Expression	=IF($J5="W";1;0)	text	NO

Cells with Data Validation
Cell	Allow	Criteria
J5	List	=ResultSymbols

i would like to have a macro button in the sheet called "Stakes" where the feeder exist in order to
1)copy the selected data from the pivot table
2)move to sheet "Stakes History"
3)paste the data in the top row of table "t_StakeHistory", without overwriting existing data, but moving all data down

* I select the data range to be copied from the pivot table using below code

Sub Selectpvt_FinalStakes()
    
    Dim pt As PivotTable
    Set pt = ActiveSheet.PivotTables("pvt_FinalStakes")
    
    Dim Rng As Range
    Set Rng = pt.RowRange
    Set Rng = Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1)
    
   
    Rng.Select
    
End Sub

Is there any chance to continue after this code with the rest of the actions i need to accomplish, so i only have 1 macro button to copy the data from 1 sheet & go and paste them as described?
Thank you in advance

 

[Peter_SSs]

Is there any chance to continue after this code with the rest of the actions i need to accomplish

You don't need Rng.Select, so remove that code and in its place try this

Dim r As Long

With Sheets("Stakes History").ListObjects("t_StakeHistory")
  For r = 1 To rng.Rows.Count
    .ListRows.Add (1)
  Next r
  With .DataBodyRange
    rng.Copy
    .Cells(1).PasteSpecial Paste:=xlPasteValues
    .Cells(rng.Rows.Count + 1, .Columns.Count).Copy
    .Cells(1, .Columns.Count).PasteSpecial Paste:=xlPasteFormulas
  End With
End With
Application.CutCopyMode = False

 

[excelakos]

You don't need Rng.Select, so remove that code and in its place try this

Dim r As Long

With Sheets("Stakes History").ListObjects("t_StakeHistory")
  For r = 1 To rng.Rows.Count
    .ListRows.Add (1)
  Next r
  With .DataBodyRange
    rng.Copy
    .Cells(1).PasteSpecial Paste:=xlPasteValues
    .Cells(rng.Rows.Count + 1, .Columns.Count).Copy
    .Cells(1, .Columns.Count).PasteSpecial Paste:=xlPasteFormulas
  End With
End With
Application.CutCopyMode = False

Peter thank very much for your time. I tried your code. I made it a Sub and applied it to a button in the "Stakes" Sheet, where the pvt is. I run it and got a " 424" error Object Required. When i click debug the following line of the code is highlighted yellow:

For r = 1 To Rng.Rows.Count

Any ideas?

 

[excelakos]

You don't need Rng.Select, so remove that code and in its place try this

Dim r As Long

With Sheets("Stakes History").ListObjects("t_StakeHistory")
  For r = 1 To rng.Rows.Count
    .ListRows.Add (1)
  Next r
  With .DataBodyRange
    rng.Copy
    .Cells(1).PasteSpecial Paste:=xlPasteValues
    .Cells(rng.Rows.Count + 1, .Columns.Count).Copy
    .Cells(1, .Columns.Count).PasteSpecial Paste:=xlPasteFormulas
  End With
End With
Application.CutCopyMode = False

Forget the previous quote of mine... i did not understand your saying correctly!!! Everything works absolutely perfect!!!! An ocean of thanks!!!

 

[Peter_SSs]

Everything works absolutely perfect!!!! An ocean of thanks!!!

Good news! You are welcome and thanks for letting us know.

 

[excelakos]

Hello Peter or anyone else!!

I tried to use the the solution in this thread in another situation, but i keep getting error.
Below is the sheet where i want to copy a union of ranges which are

=Picks!$B$5:OFFSET(Picks!$B$4;GETPIVOTDATA("[Measures].[Distinct Count of Match Id]";Picks!$B$4);4)
=Picks!$J$5:OFFSET(Picks!$J$4;GETPIVOTDATA("[Measures].[Distinct Count of Match Id]";Picks!$B$4);1)

Betakos Profit AnalyzerIndicatorTest.xlsb
	B	C	D	E	F	G	H	I	J	K	L
4	Event Time	ΚΩΔ.	ΓΗΠΕΔΟΥΧΟΣ.	ΦΙΛΟΞ/ΜΕΝΗ.	ΧΩΡΑ ΔΙΟΡΓ.	Match Id	Distinct Match Id	Log Id	Time Stamp	Portfolio Picks	FilterId
5	4/3/2021 20:00	903	ΓΟΥΕΣΤ ΜΠΡΟΜ	ΕΒΕΡΤΟΝ	ΑΓΓΠ	442590,833333333333333903	1	90344261,5568469907	06/03/2021 13:21	|1|X,2|	TRUE
6	4/3/2021 20:00	904	ΦΟΥΛΑΜ	ΤΟΤΕΝΑΜ	ΑΓΓΠ	442590,833333333333333904	1	90444261,5568469907	06/03/2021 13:21	|2|X|	TRUE
7	4/3/2021 21:45	913	ΠΑΡΜΑ	ΙΝΤΕΡ	ΙΤΑ1	442590,90625913	1	91344261,5568469907	06/03/2021 13:21	|X|	TRUE
8	4/3/2021 22:15	915	ΛΙΒΕΡΠΟΥΛ	ΤΣΕΛΣΙ	ΑΓΓΠ	442590,927083333333333915	1	91544261,5568469907	06/03/2021 13:21	|2|	TRUE
9	Grand Total						4
Picks

Cell Formulas
Range	Formula
I5:I8	I5	=IF([@[Time Stamp]]="","",C5&J5)
J5:J8	J5	=MAX(IF(HistoryLogTable[Match Id]=Picks!G5,HistoryLogTable[Time Stamp]))
K5:K8	K5	=INDEX(HistoryLogTable[#Data],MATCH([@[Log Id]],HistoryLogTable[Log Id],0),MATCH(t_picks[[#Headers],[Portfolio Picks]],HistoryLogTable[#Headers],0))
L5:L8	L5	=OR([@[Portfolio Picks]]<>"")
Press CTRL+SHIFT+ENTER to enter array formulas.

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
B5:G8,I5:L8	Expression	=OR($K5<>"")	text	NO

This is the sheet i need to paste

Betakos Profit AnalyzerIndicatorTest.xlsb
	A	B	C	D	E	F	G	H
1
2
3		Event Time	ΚΩΔ.	ΓΗΠΕΔΟΥΧΟΣ.	ΦΙΛΟΞ/ΜΕΝΗ.	ΧΩΡΑ ΔΙΟΡΓ.	Time Stamp	Portfolio Picks
4
5
6
StakesPlaced

And this is the code

Sub Picks_SelectionForStakesPlaced()

'The union below refers to Sheet (Picks). rng_PicksCopy1 equals parts of a pivot table & rng_PicksCopy2 equals parts of a table

Application.Union(Range("rng_PicksCopy1"), Range("rng_PicksCopy2")).Copy


Dim r As Long

With Sheets("StakesPlaced").ListObjects("t_stakesarchive")
  For r = 1 To Rng.Rows.Count
    .ListRows.Add (1)
  Next r
  With .DataBodyRange
    Rng.Copy
    .Cells(1).PasteSpecial Paste:=xlPasteValues
    .Cells(Rng.Rows.Count + 1, .Columns.Count).Copy
    .Cells(1, .Columns.Count).PasteSpecial Paste:=xlPasteFormulas
  End With
End With
Application.CutCopyMode = False

End Sub

Attached the print screen about the error

Thank you in advance!!

 

[Peter_SSs]

You have used Rng.Copy but you have not declared Rng as a variable or set it a particular range like you did in your original code.

Dim Rng As Range
Set Rng = pt.RowRange 
Set Rng = Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1)