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

excelakos

Board Regular
Joined
Jan 22, 2014
Messages
67
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
ABCDEFGHIJ
1
2Match DayPickNoMatchPickOddsBookieFinal StakesProfit / Loss
31/2/20211(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
ABCDEFGHIJK
1
2
3
4Match DayPickNoMatchPickOddsBookieFinal StakesProfit / LossResult P/L
51/2/20211(blank)(blank)3,50 (blank) 10,00 €25,00 €w25,00 €
6
7
8
9
10
Stakes History
Cell Formulas
RangeFormula
K5K5=IF([@Result]="W",[@[Profit / Loss]],IF([@Result]="V",0,IF([@Result]="L",-[@[Profit / Loss]],"")))
Cells with Conditional Formatting
CellConditionCell FormatStop If True
B5:K5Expression=IF($J5="L";1;0)textNO
B5:K5Expression=IF($J5="V";1;0)textNO
B5:K5Expression=IF($J5="W";1;0)textNO
Cells with Data Validation
CellAllowCriteria
J5List=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

VBA 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
 

Some videos you may like

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
48,400
Office Version
  1. 365
Platform
  1. Windows
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

VBA Code:
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
 
Last edited:
Solution

excelakos

Board Regular
Joined
Jan 22, 2014
Messages
67
You don't need Rng.Select, so remove that code and in its place try this

VBA Code:
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:

VBA Code:
For r = 1 To Rng.Rows.Count

Any ideas?
 

excelakos

Board Regular
Joined
Jan 22, 2014
Messages
67
You don't need Rng.Select, so remove that code and in its place try this

VBA Code:
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

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
48,400
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Everything works absolutely perfect!!!! An ocean of thanks!!!
Good news! You are welcome and thanks for letting us know. :)
 

excelakos

Board Regular
Joined
Jan 22, 2014
Messages
67
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

Excel Formula:
=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
BCDEFGHIJKL
4Event TimeΚΩΔ.ΓΗΠΕΔΟΥΧΟΣ.ΦΙΛΟΞ/ΜΕΝΗ.ΧΩΡΑ ΔΙΟΡΓ.Match IdDistinct Match IdLog IdTime StampPortfolio PicksFilterId
54/3/2021 20:00903ΓΟΥΕΣΤ ΜΠΡΟΜΕΒΕΡΤΟΝΑΓΓΠ442590,833333333333333903190344261,556846990706/03/2021 13:21|1|X,2|TRUE
64/3/2021 20:00904ΦΟΥΛΑΜΤΟΤΕΝΑΜΑΓΓΠ442590,833333333333333904190444261,556846990706/03/2021 13:21|2|X|TRUE
74/3/2021 21:45913ΠΑΡΜΑΙΝΤΕΡΙΤΑ1442590,90625913191344261,556846990706/03/2021 13:21|X|TRUE
84/3/2021 22:15915ΛΙΒΕΡΠΟΥΛΤΣΕΛΣΙΑΓΓΠ442590,927083333333333915191544261,556846990706/03/2021 13:21|2|TRUE
9Grand Total4
Picks
Cell Formulas
RangeFormula
I5:I8I5=IF([@[Time Stamp]]="","",C5&J5)
J5:J8J5=MAX(IF(HistoryLogTable[Match Id]=Picks!G5,HistoryLogTable[Time Stamp]))
K5:K8K5=INDEX(HistoryLogTable[#Data],MATCH([@[Log Id]],HistoryLogTable[Log Id],0),MATCH(t_picks[[#Headers],[Portfolio Picks]],HistoryLogTable[#Headers],0))
L5:L8L5=OR([@[Portfolio Picks]]<>"")
Press CTRL+SHIFT+ENTER to enter array formulas.
Cells with Conditional Formatting
CellConditionCell FormatStop If True
B5:G8,I5:L8Expression=OR($K5<>"")textNO


This is the sheet i need to paste

Betakos Profit AnalyzerIndicatorTest.xlsb
ABCDEFGH
1
2
3Event TimeΚΩΔ.ΓΗΠΕΔΟΥΧΟΣ.ΦΙΛΟΞ/ΜΕΝΗ.ΧΩΡΑ ΔΙΟΡΓ.Time StampPortfolio Picks
4
5
6
StakesPlaced


And this is the code

VBA 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!!
 

Attachments

  • Mrexcel5.png
    Mrexcel5.png
    18.3 KB · Views: 5

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
48,400
Office Version
  1. 365
Platform
  1. Windows
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.

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

Watch MrExcel Video

Forum statistics

Threads
1,127,530
Messages
5,625,361
Members
416,096
Latest member
forevans

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top